Does anyone have experience with using the Winspool.EnumprinterData API in Delphi?
I found a demo for C++:
https://s-kita.hatenablog.com/entry/20120227/1330353801
I tried to covert it to Delphi as below:
procedure TForm1.GetPrinterData;
var
hPrinter : THandle;
pInfo: PPrinterInfo2;
bytesNeeded: DWORD;
dwRet : DWORD;
dwIndex: DWORD;
pValueName: PWideChar;
pTagName: PWideChar;
cbValueName: DWORD;
pcbValueName : DWORD;
pType: DWORD;
pData: PByte;
cbData: DWORD;
pcbData: PDWORD;
i : Integer;
printername : String;
dwValueNameSize : DWORD;
dwDataSize : DWORD;
begin
hprinter := GetCurrentPrinterHandle;
dwRet := EnumPrinterDataw(hprinter,i,nil,0, pcbValueName,pType,nil,0,pcbData);
end;
Question 1: EnumPrinterDataW result is not the same, even if I chose the same printer, and it often raises an Access Violation error.
Question 2: the API has many pointer type variables, the next step should allocate memory to some variable, but I do not know how to do thqt. For example pData: PByte; Pdata = Allocmem(pcbData^); <==== this is difficult to me, Pdata is TByte, how to allocmem(pcbData^) is TPwidechar how to do this?
This has taken me 2 days to deal with, and it is still a mess !!!!
There are some mistakes in your code:
you are not checking if GetCurrentPrinterHandle() returns a valid printer handle.
you are not initializing your i variable. You need to pass a 0-based index to EnumPrinterData(), but the value of i is indeterminate.
you are not initializing your pcbData variable. EnumPrinterData() expects a pointer to a DWORD variable that will receive the size of the data written to the pData buffer (or the needed size of the pData buffer if pData is nil). But your pcbData is not pointing to a valid DWORD.
Try something more like this:
procedure TForm1.GetPrinterData;
var
hPrinter: THandle;
dwIndex,
dwRet,
dwType,
dwMaxValueNameSize,
dwMaxDataSize,
dwValueNameSize,
dwDataSize: DWORD;
pValueName,
lpData: array of Byte;
sValueName: UnicodeString; // or WideString in D2007 and earlier
begin
hPrinter := GetCurrentPrinterHandle;
if hPrinter = 0 then
Exit; // or raise an exception
try
dwIndex := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, nil, 0, dwMaxValueNameSize, dwType, nil, 0, #dwMaxDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLastOSError(dwRet);
SetLength(pValueName, dwMaxValueNameSize);
SetLength(pData, dwMaxDataSize);
repeat
dwValueNameSize := 0;
dwDataSize := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, PWideChar(pValueName), dwMaxValueNameSize, dwValueNameSize, dwType, PByte(pData), dwMaxDataSize, #dwDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLasstOSError(dwRet);
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
// use dwType, sValueName, and pData up to dwDataSize bytes, as needed...
Inc(dwIndex);
until False;
finally
// only if GetCurrentPrinterHandle returns a handle that needs to be closed now...
ClosePrinter(hPrinter);
end;
end;
Thanks for your great great help!
But have more questions, need your help. (sorry, I'm not good at English)
Q1. in your answer :
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
I dont understnt this SetLength format.....and complier raise an Error :
[DCC Error] Unit1.pas(111): E2008 Incompatible types
Q2. how to get value :
sValueName ----> ValueName : array of Byte, how to get string value form an array of Byte
sorry for my poor ability. I really do not get pointer type Data, need more study
Related
Based on and using the Jedi Demo VHD, I've created a virtual disk, and can mount and dismount it. When mounted, it appears in the Disk Manager as disk 1 "unknown".
Going on to initialize and format it in my code, I am trying with the following code:
procedure TMainForm.BtnInitClick(Sender: TObject);
var RetBytes: DWORD;
hDevice: Cardinal;
Status: LongBool;
Drive: string;
CDsk : TCreateDisk;
PS : TPartitionStyle;
begin
hDevice := INVALID_HANDLE_VALUE;
Drive := GetDiskPath(Edit1.Text);
hDevice:=CreateFile(PChar(Drive), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
try
memoinfo.Lines.Add('CreateFile Success. hDevice = '+hDevice.ToString);
CDsk.PartitionStyle := PARTITION_STYLE_GPT;
CDsk.Gpt.DiskId := TGuid.Empty;
CDsk.Gpt.MaxPartitionCount := 0;
Status := DeviceIoControl(hDevice, IOCTL_DISK_CREATE_DISK, #CDsk, SizeOf(CDsk), nil, 0, #RetBytes, nil);
try
memoinfo.Lines.Add('DeviceControl Success');
except
on e: exception do memoinfo.Lines.Add('DeviceControl Error : '+e.Message);
end;
except
on e: exception do memoinfo.Lines.Add('CreateFile Error : '+e.Message);
end;
end;
GetDiskPath gets '\.\PhysicalDisk1' when edit1.text contains the name of my virtual disk (TestDisk.vhd) and both CreateFile and DeviceIoControl generate 'Success', but the disk in Disk Manager stays unchanged.
What am I doing wrong ?
NB! If you have a answer based on C#, that would be fine too.
I'm using google distancematrix to calculate travel expenses for emplyees. This all worked fine a while ago, and for several clients running it on location also.
Now I'm researching a bug (that really has nothing to do with this API), and when I make the API call from my debugging environment, I get:
"HttpSendRequest Error 12157: an error occurred in the secure channel support"
When I make the same request from a browser, it all works fine and I get the XML-file I'm requesting.
This is strictly local issue; at the client site the distances are calculated just fine.
Here's the code I use:
function Https_Get(const ServerName,Resource : string;Var Response:AnsiString): Integer;
const
BufferSize=1024*64;
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
ErrorCode : Integer;
lpvBuffer : PAnsiChar;
lpdwBufferLength: DWORD;
lpdwReserved : DWORD;
dwBytesRead : DWORD;
lpdwNumberOfBytesAvailable: DWORD;
begin
Result :=0;
Response:='';
hConnect := InternetConnect(hInet, PChar(ServerName), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if hConnect=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//make the request
hRequest := HttpOpenRequest(hConnect, 'GET', PChar(Resource), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, 0);
if hRequest=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//send the GET request
if not HttpSendRequest(hRequest, nil, 0, nil, 0) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
Coded elsewhere:
sServer = 'maps.googleapis.com';
sParams = '/maps/api/distancematrix/xml?origins=%s+NL&destinations=%s+NL&sensor=false';
...
ResponseCode:=Https_Get(sServer,Format(sParams,[PostcodeVan, PostcodeNaar]), Response);
PostcodeVan and PostcodeNaar are the two ZIP codes and properly filled. Code cancels at the HttpSendRequest statement.
Anyone got any ideas? Especially the fact that it the (server+resource) link in a browser works fine dazzles me!
Thanks in advance!
I have simple "RAM" implemented as:
type memory_array is array(31 downto 0) of std_logic_vector(7 downto 0);
signal ram : memory_array;
I would like to init it's content from HEX file. I wonder about reading the file like:
ram_init: process
file file_ptr : text;
variable line_text : string(1 to 14);
variable line_num : line;
variable lines_read : integer := 0;
variable char : character;
variable tmp_hexnum : string(1 to 2);
begin
file_open(file_ptr,"../RAM.HEX",READ_MODE);
while (not endfile(file_ptr)) loop
readline (file_ptr,line_num);
READ (line_num,line_text);
if (lines_read < 32) then
tmp_hexnum := line_text(10 to 11);
-- ram(lines_read) <= tmp_hexnum;
lines_read := lines_read + 1;
wait for 10 ns;
end if;
end loop;
file_close(file_ptr);
wait;
end process;
The problem is (if this code above would works, which I don't even know), how to convert the tmp_hexnum string to std_logic_vector.
Please have patience with me, VHDL beginner.
The first mistake is to use a process : if you attempt to synthesise the design, the process won't do anything until the design is built and running; which is far too late to read a file!
Instead, wrap the init code in a function, and use that to initialise the memory
signal ram : memory_array := my_ram_init(filename => "../RAM.HEX");
This will work in simulation, and many synthesis tools will infer a RAM and initialise it correctly. If you declared a constant instead of a signal, this would create a ROM instead of a RAM.
Anyway the function looks a bit like
function my_ram_init(filename : string) return memory_array is
variable temp : memory_array;
-- other variables
begin
file_open(...);
-- you have a good handle on the function body
file_close(...);
return temp;
end function;
leaving you with the original problem :
temp(lines_read) <= to_slv(tmp_hexnum);
writing the to_slv function. There ought to be a standard library of these, but for some reason there isn't a universally accepted one. So, here's a start...
function to_slv (tmp_hexnum : string) return std_logic_vector is
variable temp : std_logic_vector(7 downto 0);
variable digit : natural;
begin
for i in tmp_hexnum'range loop
case tmp_hexnum(i) is
when '0' to '9' =>
digit := Character'pos(tmp_hexnum(i)) - Character'pos('0');
when 'A' to 'F' =>
digit := Character'pos(tmp_hexnum(i)) - Character'pos('A') + 10;
when 'a' to 'f' =>
digit := Character'pos(tmp_hexnum(i)) - Character'pos('a') + 10;
when others => digit := 0;
end case;
temp(i*4+3 downto i*4) := std_logic_vector(to_unsigned(digit));
end loop;
return temp;
end function;
Converting a string of variable length to std_logic_vector with length as 4 *
length of string, can be done with the function below:
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all;
...
-- Convert string to std_logic_vector, assuming characters in '0' to '9',
-- 'A' to 'F', or 'a' to 'f'.
function str_to_slv(str : string) return std_logic_vector is
alias str_norm : string(1 to str'length) is str;
variable char_v : character;
variable val_of_char_v : natural;
variable res_v : std_logic_vector(4 * str'length - 1 downto 0);
begin
for str_norm_idx in str_norm'range loop
char_v := str_norm(str_norm_idx);
case char_v is
when '0' to '9' => val_of_char_v := character'pos(char_v) - character'pos('0');
when 'A' to 'F' => val_of_char_v := character'pos(char_v) - character'pos('A') + 10;
when 'a' to 'f' => val_of_char_v := character'pos(char_v) - character'pos('a') + 10;
when others => report "str_to_slv: Invalid characters for convert" severity ERROR;
end case;
res_v(res_v'left - 4 * str_norm_idx + 4 downto res_v'left - 4 * str_norm_idx + 1) :=
std_logic_vector(to_unsigned(val_of_char_v, 4));
end loop;
return res_v;
end function;
Your (both) answers helped me a lot. But it seems not working.
function ram_init(filename : string) return memory_array is
variable temp : memory_array;
file file_ptr : text;
variable line_line : line;
variable line_text : string(1 to 14);
variable tmp_hexnum : string(1 to 2);
variable lines_read : integer := 0;
begin
file_open(file_ptr,filename,READ_MODE);
while (lines_read < 32 and not endfile(file_ptr)) loop
readline (file_ptr,line_line);
read (line_line,line_text);
tmp_hexnum := line_text(10 to 11);
temp(lines_read) := hex_to_bin(tmp_hexnum);
lines_read := lines_read + 1;
end loop;
file_close(file_ptr);
return temp;
end function;
signal ram : memory_array := ram_init(filename=>"../RAM.HEX");
If I set tmp_hexnum to e.g. "0A", it's OK, but reading from file do not fill the RAM.
Can you please check the file part for me, too?
I am working on creating a chat program. But for some reason my stream won't come through. Could someone check my code and tell me what I am doing wrong?
Client side:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
myStream.Size := Length(Chat);
myStream.WriteBuffer(Pointer(Chat)^, Length(Chat));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
//Free the stream
myStream.Free;
end;
Server Side:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Pointer(Chat)^,Length(Chat),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;
If you're using D2009 or later, then when sending, you're cutting the data in half. Also, given you will ultimately be reading the data with ReceiveBuf, it would probably be sensible to prepend a length marker. Less substantively, you also don't need to set the memory stream's Size up front, and should wrap the stream usage in a try/finally block:
procedure TForm1.Button1Click(Sender: TObject);
var
myStream : TMemoryStream;
chat : String;
Len: Int32;
begin
//Creating a stream
chat := 'bladibla';
myStream := TMemoryStream.Create();
try
Len := Length(Chat);
myStream.WriteBuffer(Len, SizeOf(Len));
myStream.WriteBuffer(Pointer(Chat)^, Len * SizeOf(Char));
//Resetting the stream position
myStream.Position := 0;
//Sending the stream
TcpClient1.Active := true;
TcpClient1.SendStream(myStream);
TcpClient1.Active := false;
finally
//Free the stream
myStream.Free;
end;
end;
In the case of the receiving code, you haven't pre-allocated the Chat buffer. As such, Length(Chat) will be 0. Given my suggested code above, we can read off the length marker first:
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
chat : string;
Len: Int32;
begin
//Receives the message from the client
ClientSocket.ReceiveBuf(Len, SizeOf(Len),0);
SetLength(Chat, Len);
ClientSocket.ReceiveBuf(Pointer(Chat)^,Len * SizeOf(Char),0);
memo1.Lines.Add(chat);
memo1.Lines.Add('------');
end;
Lastly... the components used in this code are deprecated, so it might be an idea to investigate Indy instead.
I override the function library kernel32.dll in Pascal and OpenProcess function returns 0. Function GetLastError() returns 87 error, that means
ERROR_INVALID_PARAMETER
87 (0x57)
The parameter is incorrect.
What could be wrong?
Program UODll;
const search_window = 'Ultima Online - xxx (The Abyss)';
function FindWindow(C1, C2: PChar): Longint; external 'FindWindowA#user32.dll stdcall';
function GetWindowThreadProcessId(hWnd: Longint; opt: Word): Word; external 'GetWindowThreadProcessId#user32.dll stdcall';
function OpenProcess(dwDesiredAccess: Word; inherit: Byte; pid: Word): Longint; external 'OpenProcess#kernel32.dll stdcall';
function GetProcessId(proc: Longint): Word; external 'GetProcessId#kernel32.dll stdcall';
function GetLastError(): Word; external 'GetLastError#kernel32.dll stdcall';
var
res, err: Word;
wnd, proc: Longint;
Begin
wnd := Findwindow('', search_window);
if (wnd > 0) then
begin
res := GetWindowThreadProcessId(wnd, res);
proc := OpenProcess($0400,0,res);
err := GetLastError();
writeln(IntToStr(proc));
writeln(IntToStr(err));
end;
End.
Im trying to use LongWord and Cardinal, but i have the same error.. Who can help me?)
P.S. its not delphi.. i dont know what is this :) Programm calls UOScript
OpenProcess has declaration
HANDLE WINAPI OpenProcess(
_In_ DWORD dwDesiredAccess,
_In_ BOOL bInheritHandle,
_In_ DWORD dwProcessId
);
dwDesiredAccess and pid are double words that are
typedef unsigned long DWORD;
i.e. 32bit on x86, according to this answer.
But Delphi/Pascal Word type is 16bit.
Also, BOOL is defined as
typedef int BOOL;
So, you should use Integer for inherit instead of Byte
So, your function declaration is incorrect.
Seems you should use Cardinal or LongWord instead of Word in your declarations.
If you use Delphi, you can import Windows module that has all Win API functions defined.