In my application, all printers are listed using printer.printers command. This lists only printer names. Upon selection, it is saved in the Database.
Later on, this printer name is assigned using the AssignFilefunction to a text file.
And printing is done using Rewrite function.
If I save the selected printer as \\PCname\printer name in the database and then use it with Rewrite function then it works.
But if we save only printer name in the database then printing is not happening.
Is it necessary to save \\PCname\printer name path? or Is there any other solution.
Anotherway than printing using the Pascal file access functions is to use the Windows API for the spooler.
function PrintWithSpooler(const Name: string; const Data: AnsiString): integer;
var
hPrinter: THandle;
DocInfo: TDocInfo1;
bSuccess: boolean;
dwBytesWritten: DWORD;
begin
result := S_OK;
bSuccess := false;
DocInfo.pOutputFile := nil;
DocInfo.pDatatype := 'RAW';
DocInfo.pDocName := 'Label';
if OpenPrinter(PChar(Trim(Name)), hPrinter, nil) then
begin
try
if StartDocPrinter(hPrinter, 1, #DocInfo) > 0 then
begin
try
if StartPagePrinter(hPrinter) then
begin
try
bSuccess := WritePrinter(hPrinter, Pointer(Data), Length(Data), dwBytesWritten);
finally
EndPagePrinter(hPrinter);
end;
end;
finally
EndDocPrinter(hPrinter);
end;
end;
finally
ClosePrinter(hPrinter);
end;
end;
if not bSuccess then
begin
result := GetLastError;
// in case there was no error from GetLastError
if result = S_OK then
result := S_FALSE;
end;
end;
Obviously, you need PCname. You can save it in the database as you said but it will be a problem if the database is used from several PC, the only save printer name in the database and add PCname on the PC using the printer. You can get PCname using GetComputerName
Related
I am trying to export a registry key using either TRegistry.SaveKey or RegSaveKey functions with no luck. All I get is an empty file 0 bytes. I have seen examples online none seems to be working on Windows10.
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
reg.Access := KEY_ALL_ACCESS;
if reg.OpenKey('\Software\MyCompanyName\MyApplication\', True) then
begin
reg.WriteInteger('background', Self.Color);
reg.SaveKey('HKEY_CURRENT_USER\Software\MyCompanyName\MyApplication', 'test.txt'); //not working
RegSaveKey(reg.CurrentKey, 'test.reg', nil); //creates empty file
end;
reg.CloseKey;
reg.Free;
Also if I extract existing key from RegEdit and then try to load it in the application using TRegistry.LoadKey or RegLoadKey nothing is happening
I do have admin right on the machine I run this.
Anyone familiar with the issue?
From the documentation of RegSaveKey:
The calling process must have the SE_BACKUP_NAME privilege enabled.
My guess is that RegSaveKey returning a value other than ERROR_SUCCESS. which your code does not check.
See also:
RegSaveKey returns ERROR_PRIVILEGE_NOT_HELD
Another thing to check for is that the destination file does not exists before you try to save, or else the function will fail (this is also mentioned in the documentation), and obviously that you have write permissions to the file location.
Here is a working example.
Be aware that you must run the program as administrator.
program SO59753973;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Registry,
Windows,
System.SysUtils;
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
hToken: THandle;
TokenPriv: TOKEN_PRIVILEGES;
PrevTokenPriv: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
errval:Cardinal;
begin
Result := True;
errval:=0;
// Only for Windows NT/2000/XP and later.
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
Result := False;
// obtain the processes token
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
try
// Get the locally unique identifier (LUID) .
if LookupPrivilegeValue(nil, PChar(sPrivilege),TokenPriv.Privileges[0].Luid) then
begin
TokenPriv.PrivilegeCount := 1; // one privilege to set
case bEnabled of
True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
False: TokenPriv.Privileges[0].Attributes := 0;
end;
ReturnLength := 0; // replaces a var parameter
PrevTokenPriv := TokenPriv;
// enable or disable the privilege
if AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),PrevTokenPriv, ReturnLength) then
Result := True
else
begin
errval:= GetLastError;
Result := errval = 0;
end;
end;
finally
CloseHandle(hToken);
end;
// test the return value of AdjustTokenPrivileges.
//Result := GetLastError = ERROR_SUCCESS;
if not Result then
raise Exception.Create(SysErrorMessage(errval));
end;
var
Reg: TRegistry;
sKeyFileName: String;
begin
try
if not NTSetPrivilege('SeBackupPrivilege',true) then
Exit;
sKeyFileName := 'C:\temp\tempReg.reg';
if FileExists(sKeyFileName) then
DeleteFile(sKeyFileName);
Reg := TRegistry.Create(KEY_ALL_ACCESS);
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.SaveKey('\Software\Microsoft', sKeyFileName)
then
Writeln('Registry has been saved!')
else
Writeln('Failed to save registry, received error: ' + IntToStr(Reg.LastError) + '!');
finally
Reg.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
For restoring the registry, you must enable the SE_RESTORE_NAME in addition to the SE_BACKUP_NAME Privilege.
Code has been taken (and adapted) from this old forum post
Need to send data directly to XPS printer in windows 7 and above using flag XPS_PASS as mentioned in https://support.microsoft.com/en-us/help/2779300/v4-print-drivers-using-raw-mode-to-send-pcl-postscript-directly-to-the however this flag is not defined in Delphi.
XPS_PASS is not a flag. It's a character string that indicates the document type. The other possible value is RAW, which is also a character string.
Here's a quick direct translation (compiled, but untested) of the example code Microsoft provides in How to Send Data Directly to an XPS Printer
uses
Winapi.WinSpool;
function RawDataToXpsPrinter(PrinterName: String; Data: TBytes; DataCount: Cardinal): Boolean;
var
hPrinter: NativeUInt;
DocInfo: DOC_INFO_1;
PrintJob: Cardinal;
BytesWritten: Cardinal;
begin
Result := OpenPrinter(PChar(PrinterName), hPrinter, nil);
if Result then
begin
DocInfo.pDocName := PChar('My Document');
DocInfo.pOutputFile := nil;
DocInfo.pDatatype := PChar('XPS_PASS');
PrintJob := StartDocPrinter(hPrinter, 1, #DocInfo);
if (PrintJob > 0) then
begin
Result := WritePrinter(hPrinter, Data, DataCount, BytesWritten);
EndDocPrinter(hPrinter);
if Result then
Result := ClosePrinter(hPrinter);
Result := Result and (BytesWritten = DataCount);
end;
end;
end;
It's up to you to find the proper name of the XPS Printer driver to pass as PrinterName and put the data you want to print into a TBytes array to pass to the function as Data. DataCount would be the length of that data. Presumably you've already got that, as your question here was only how to pass 'XPS_PASS'.
I'm trying to verify whether a resource exists in another Delphi application, the problem is that only know how to do it locally, I mean in the application itself.
Source:
function exists_resource(name: string): boolean;
begin
if (FindResource(HInstance, PChar(name), RT_RCDATA) <> 0) then
begin
Result := True;
end
else
begin
Result := False;
end;
end;
As I can verify this in a different application?
Use LoadLibraryEx to load the external file.
function exists_resource(const name, filename: string): boolean;
var
HInst: THandle;
begin
HInst:= LoadLibraryEx(PChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE or LOAD_LIBRARY_AS_IMAGE_RESOURCE);
//Win32Check(HInst); //Uncomment if you want to generate errors.
if HInst = 0 then exit(false);
try
Exit((FindResource(HInst, PChar(name), RT_RCDATA) <> 0));
finally
FreeLibrary(Hinst);
end; {try}
end;
Note that using LoadLibraryEx in this way will work for loading both dll's and exe's.
Using the code below I try to set a value in the HKEY_LOCAL_MACHINE section of registry but I get an error 'Failed to set data for.....'
If I use HKEY_CURRENT_USER there is no problem.
What might I be missing here.
(The code is not complete, but I think it is the important parts of it)
type
TTypWinBits = (Bit32, Bit64);
function WinBits: TTypWinBits;
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
hKernel32 : Integer;
IsWow64Process : TIsWow64Process;
IsWow64 : BOOL;
begin
Result := Bit32;
hKernel32 := LoadLibrary('kernel32.dll');
if (hKernel32 = 0) then RaiseLastOSError;
#IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
if Assigned(IsWow64Process) then
begin
IsWow64 := False;
if (IsWow64Process(GetCurrentProcess, IsWow64)) then
Result := Bit64
else
RaiseLastOSError;
end;
FreeLibrary(hKernel32);
end;
function TFastRegistry.CreateConnection: TRegistry;
begin
Result := TRegistry.Create;
try
case WinBits of
Bit32: Result := TRegistry.Create;
Bit64: Result := TRegistry.Create(KEY_WRITE OR KEY_WOW64_64KEY);
end;
except
on E: exception do
Result := nil;
end;
end;
procedure TFastRegistry.RunAdd(aDesc, aName: string);
var
Reg: TRegistry;
sRegKey: String;
begin
sRegKey := 'Software\Microsoft\Windows\CurrentVersion\Run';
Reg := CreateConnection;
with Reg do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if not KeyExists(sRegKey) then
OpenKey(sRegKey, True)
else
OpenKey(sRegKey, False);
WriteString(aDesc, aName);
finally
CloseKey;
Free;
end;
end;
end;
A program requires elevated privileges to write to the local-machine key. Without that, functions will fail, as you've observed. If your program is supposed to be an administrative tool, then use a manifest file so the OS will prompt for permission. If you don't need that, then write to the current-user key instead so it doesn't affect all accounts on the system.
You just need to release the handle by the "Free" and for the next entry in the register to recreate it, and not keep it permanently set up and open and close them through OpenKey and CloseKey! It looks like a bug :-)
I am trying to remotely read a binary (REG_BINARY) registry value, but I get nothing but junk back. Any ideas what is wrong with this code? I'm using Delphi 2010:
function GetBinaryRegistryData(ARootKey: HKEY; AKey, AValue, sMachine: string; var sResult: string): boolean;
var
MyReg: TRegistry;
RegDataType: TRegDataType;
DataSize, Len: integer;
sBinData: string;
bResult: Boolean;
begin
bResult := False;
MyReg := TRegistry.Create(KEY_QUERY_VALUE);
try
MyReg.RootKey := ARootKey;
if MyReg.RegistryConnect('\\' + sMachine) then
begin
if MyReg.KeyExists(AKey) then
begin
if MyReg.OpenKeyReadOnly(AKey) then
begin
try
RegDataType := MyReg.GetDataType(AValue);
if RegDataType = rdBinary then
begin
DataSize := MyReg.GetDataSize(AValue);
if DataSize > 0 then
begin
SetLength(sBinData, DataSize);
Len := MyReg.ReadBinaryData(AValue, PChar(sBinData)^, DataSize);
if Len <> DataSize then
raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
else
begin
sResult := sBinData;
bResult := True;
end;
end;
end;
except
MyReg.CloseKey;
end;
MyReg.CloseKey;
end;
end;
end;
finally
MyReg.Free;
end;
Result := bResult;
end;
And I call it like this:
GetBinaryRegistryData(
HKEY_LOCAL_MACHINE,
'\SOFTWARE\Microsoft\Windows NT\CurrentVersion',
'DigitalProductId', '192.168.100.105',
sProductId
);
WriteLn(sProductId);
The result I receive from the WriteLn on the console is:
ñ ♥ ???????????6Z ????1 ???????☺ ???♦ ??3 ? ??? ?
??
Assuming that you are already connected remotely, try using the GetDataAsString function
to read binary data from the registry.
sResult := MyReg.GetDataAsString(AValue);
You're using Delphi 2010, so all your characters are two bytes wide. When you set the length of your result string, you're allocating twice the amount of space you need. Then you call ReadBinaryData, and it fills half your buffer. There are two bytes of data in each character. Look at each byte separately, and you'll probably find that your data looks less garbage-like.
Don't use strings for storing arbitrary data. Use strings for storing text. To store arbitrary blobs of data, use TBytes, which is an array of bytes.