The Road to Delphi – a Blog about programming

Delphi – Lazarus – Delphi Prism

Monthly Archives: July 2011


by 8 Comments

Manipulating local/remote files and folders using Delphi and WMI

Some days ago a question in stackoverflow.com was made, about how list the contents of a folder of a remote machine. I answer that question using a WMI approach mentioning the CIM_DataFile and CIM_Directory WMI Classes, these classes  can be used to retrieve information about files, folders and perform many task like copy, rename, delete and  compress.  So today I will show you how you can use these classes form Delphi.

First you must know which in order to access any file or folder  in a remote machine need not be a shared resource, only just must enable the WMI remote access in the machine to access, check these articles for more details about how enable the remote wmi access.

After of enabling the WMI remote access in the client machine you are ready to access the files and folders.

Before to begin

Now some tips which can help you to deal both classes

  1. When you make a WMI query against these classes always you must use filters (Where conditions) to restrict the result of these WMI classes.
  2. Always you must use the Drive field as condition, due to two reasons, first these classes will scan all directories on any available storage device. So this task can take some time. and second to diffentiate for example a folder called Windows located in the Drive C: and in the Drive D:.
  3. The Wmi interprets the \ (Backslash) character as a reserved symbol so you need to escape that character to avoid problems with the WQL sentence.
  4. You can use these classes to find files or folders which match with a criteria, but remember if you not specify the Path property the WMI will scan the entire drive. so try to avoid  sentences like
FWMIService.ExecQuery(Format('SELECT * FROM CIM_DataFile Where Drive="%s" AND Extension="%s"',['C:','jpg']),'WQL',wbemFlagForwardOnly);//this will return all the jpg files in the C Drive

Note :
The code showed in this article uses Late binding to access the WMI, if you want use another way to access the WMI from delphi (like direct COM access or importing th e Microsoft scripting library) take a look to the Delphi WMI Code creator.

Listing Folder and Files

//list the files and folders of a specified Path (non recursive)
procedure  ListFolderContent(Const WbemComputer,WbemUser,WbemPassword,Path:string);
const
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
  WmiPath       : string;
  Drive         : string;
begin;
  //Extract the drive from the Path
  Drive   :=ExtractFileDrive(Path);
  //add a back slash to the end of the folder
  WmiPath :=IncludeTrailingPathDelimiter(Copy(Path,3,Length(Path)));
  //escape the folder name
  WmiPath :=StringReplace(WmiPath,'\','\\',[rfReplaceAll]);

  Writeln('Connecting');
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  //establish the connection
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);

  Writeln('Files');
  //get the files
  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM CIM_DataFile Where Drive="%s" AND Path="%s"',[Drive,WmiPath]),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('%s',[FWbemObject.Name]));// String
    FWbemObject:=Unassigned;
  end;

  Writeln('Folders');
  //get the folders
  FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM CIM_Directory Where Drive="%s" AND Path="%s"',[Drive,WmiPath]),'WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('%s',[FWbemObject.Name]));// String
    FWbemObject:=Unassigned;
  end;
end;

How to use

begin
 try
    CoInitialize(nil);
    try
      //ListFolderContent('.','','','C:\data'); //get the content of the folder Data in he local machine
      ListFolderContent('remotemachine','user_name','password','C:\Data');
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.

Get info about a particular file or folder


This code will list the type, size, creation date, attributes, etc. of any file which you pass as parameter

procedure  GetCIM_DataFileInfo(const FileName:string);
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Writeln(Format('AccessMask               %s',[FWbemObject.AccessMask]));// Uint32
  Writeln(Format('Archive                  %s',[FWbemObject.Archive]));// Boolean
  Writeln(Format('Caption                  %s',[FWbemObject.Caption]));// String
  Writeln(Format('Compressed               %s',[FWbemObject.Compressed]));// Boolean
  Writeln(Format('CompressionMethod        %s',[FWbemObject.CompressionMethod]));// String
  Writeln(Format('CreationClassName        %s',[FWbemObject.CreationClassName]));// String
  Writeln(Format('CreationDate             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.CreationDate))]));// Datetime
  Writeln(Format('CSCreationClassName      %s',[FWbemObject.CSCreationClassName]));// String
  Writeln(Format('CSName                   %s',[FWbemObject.CSName]));// String
  Writeln(Format('Description              %s',[FWbemObject.Description]));// String
  Writeln(Format('Drive                    %s',[FWbemObject.Drive]));// String
  Writeln(Format('EightDotThreeFileName    %s',[FWbemObject.EightDotThreeFileName]));// String
  Writeln(Format('Encrypted                %s',[FWbemObject.Encrypted]));// Boolean
  Writeln(Format('EncryptionMethod         %s',[FWbemObject.EncryptionMethod]));// String
  Writeln(Format('Extension                %s',[FWbemObject.Extension]));// String
  Writeln(Format('FileName                 %s',[FWbemObject.FileName]));// String
  Writeln(Format('FileSize                 %s',[FWbemObject.FileSize]));// Uint64
  Writeln(Format('FileType                 %s',[FWbemObject.FileType]));// String
  Writeln(Format('FSCreationClassName      %s',[FWbemObject.FSCreationClassName]));// String
  Writeln(Format('FSName                   %s',[FWbemObject.FSName]));// String
  Writeln(Format('Hidden                   %s',[FWbemObject.Hidden]));// Boolean
  Writeln(Format('InstallDate              %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.InstallDate))]));// Datetime
  Writeln(Format('InUseCount               %s',[FWbemObject.InUseCount]));// Uint64
  Writeln(Format('LastAccessed             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastAccessed))]));// Datetime
  Writeln(Format('LastModified             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastModified))]));// Datetime
  Writeln(Format('Manufacturer             %s',[FWbemObject.Manufacturer]));// String
  Writeln(Format('Name                     %s',[FWbemObject.Name]));// String
  Writeln(Format('Path                     %s',[FWbemObject.Path]));// String
  Writeln(Format('Readable                 %s',[FWbemObject.Readable]));// Boolean
  Writeln(Format('Status                   %s',[FWbemObject.Status]));// String
  Writeln(Format('System                   %s',[FWbemObject.System]));// Boolean
  Writeln(Format('Version                  %s',[FWbemObject.Version]));// String
  Writeln(Format('Writeable                %s',[FWbemObject.Writeable]));// Boolean
  Writeln('');
end;

In the above code you note two things, first I’m using the SWbemServices.Get method instead SWbemServices.ExecQuery this is because the Get function retrieve a single instance of the wmi object path passed as parameter  (the wmi object path is a string that uniquely identifies a instances of a class). The second
which you must note is the WbemTimeToDateTime  function, this is a helper function to convert the returned WMI datetime values in UTC format to TDateTime.

This is the code of that function, for more info check the documentation about the WbemScripting.SWbemDateTime object.

function WbemTimeToDateTime(const V : OleVariant): TDateTime;
var
  Dt : OleVariant;
begin
  Result:=0;
  if VarIsNull(V) then exit;
  Dt:=CreateOleObject('WbemScripting.SWbemDateTime');
  Dt.Value := V;
  Result:=Dt.GetVarDate;
end;

This code will list the size, creation date, atributes, etc. of any folder which you pass as parameter

procedure  GetCIM_DirectoryInfo(const FolderName:string);
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  Writeln(Format('AccessMask               %s',[FWbemObject.AccessMask]));// Uint32
  Writeln(Format('Archive                  %s',[FWbemObject.Archive]));// Boolean
  Writeln(Format('Caption                  %s',[FWbemObject.Caption]));// String
  Writeln(Format('Compressed               %s',[FWbemObject.Compressed]));// Boolean
  Writeln(Format('CompressionMethod        %s',[FWbemObject.CompressionMethod]));// String
  Writeln(Format('CreationClassName        %s',[FWbemObject.CreationClassName]));// String
  Writeln(Format('CreationDate             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.CreationDate))]));// Datetime
  Writeln(Format('CSCreationClassName      %s',[FWbemObject.CSCreationClassName]));// String
  Writeln(Format('CSName                   %s',[FWbemObject.CSName]));// String
  Writeln(Format('Description              %s',[FWbemObject.Description]));// String
  Writeln(Format('Drive                    %s',[FWbemObject.Drive]));// String
  Writeln(Format('EightDotThreeFileName    %s',[FWbemObject.EightDotThreeFileName]));// String
  Writeln(Format('Encrypted                %s',[FWbemObject.Encrypted]));// Boolean
  Writeln(Format('EncryptionMethod         %s',[FWbemObject.EncryptionMethod]));// String
  Writeln(Format('Extension                %s',[FWbemObject.Extension]));// String
  Writeln(Format('FileName                 %s',[FWbemObject.FileName]));// String
  Writeln(Format('FileSize                 %s',[FWbemObject.FileSize]));// Uint64
  Writeln(Format('FileType                 %s',[FWbemObject.FileType]));// String
  Writeln(Format('FSCreationClassName      %s',[FWbemObject.FSCreationClassName]));// String
  Writeln(Format('FSName                   %s',[FWbemObject.FSName]));// String
  Writeln(Format('Hidden                   %s',[FWbemObject.Hidden]));// Boolean
  Writeln(Format('InstallDate              %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.InstallDate))]));// Datetime
  Writeln(Format('InUseCount               %s',[FWbemObject.InUseCount]));// Uint64
  Writeln(Format('LastAccessed             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastAccessed))]));// Datetime
  Writeln(Format('LastModified             %s',[FormatDateTime('dd/mm/yyyy hh:nn:ss',WbemTimeToDateTime(FWbemObject.LastModified))]));// Datetime
  Writeln(Format('Name                     %s',[FWbemObject.Name]));// String
  Writeln(Format('Path                     %s',[FWbemObject.Path]));// String
  Writeln(Format('Readable                 %s',[FWbemObject.Readable]));// Boolean
  Writeln(Format('Status                   %s',[FWbemObject.Status]));// String
  Writeln(Format('System                   %s',[FWbemObject.System]));// Boolean
  Writeln(Format('Writeable                %s',[FWbemObject.Writeable]));// Boolean
  Writeln('');
end;

Compress a File or Folder using the NTFS compression

function  CompressFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Compress();
end;

function  CompressFolder(const FolderName:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  if Recursive then
   Result:=FWbemObject.CompressEx(StopFileName, Null, Recursive)
  else
   Result:=FWbemObject.Compress();
end;

UnCompress a File or Folder using the NTFS compression

function  UnCompressFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.UnCompress();
end;

function  UnCompressFolder(const FolderName:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  if Recursive then
   Result:=FWbemObject.UnCompressEx(StopFileName, Variants.Null, Recursive)
  else
   Result:=FWbemObject.UnCompress();
end;

Copy a single File or Folder

function  CopyFile(const SourceFileName,DestFileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(SourceFileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Copy(DestFileName);
end;

function  CopyFolder(const SourceFolder,DestFolder:string;Recursive:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OleVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(SourceFolder,'\','\\',[rfReplaceAll])]));
  if Recursive then
    Result:=FWbemObject.CopyEx(DestFolder,StopFileName, Variants.Null, Recursive)
  else
    Result:=FWbemObject.Copy(DestFolder);
end;

Delete a File or Folder

function  DeleteFile(const FileName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Delete();
end;

//remove all the contents of the folder recursivily
function  DeleteFolder(const FolderName:string):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Delete();
end;

Rename a File or Folder

function RenameFile(const OldName, NewName: string): Integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(OldName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Rename(NewName);
end;

function RenameFolder(const OldName, NewName: string): Integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(OldName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.Rename(NewName);
end;

Getting the permissions over a CIM_DataFile or CIM_Directory object

In order to get whether the caller has the permissions on the CIM_DataFile or CIM_Directory object you must use the GetEffectivePermission function with these flags

Value (Dec/Hex) Meaning
FILE_READ_DATA (file)FILE_LIST_DIRECTORY (directory)
1 (0×1)
 Grants the right to read data from the file. For a directory, this value grants the right to list the contents of the directory.
FILE_WRITE_DATA (file)FILE_ADD_FILE (directory)
2 (0×2)
 Grants the right to write data to the file. For a directory, this value grants the right to create a file in the directory.
FILE_APPEND_DATA (file)FILE_ADD_SUBDIRECTORY (directory)
4 (0×4)
 Grants the right to append data to the file. For a directory, this value grants the right to create a subdirectory.
FILE_READ_EA
8 (0×8)
 Grants the right to read extended attributes.
FILE_WRITE_EA
16 (0×10)
 Grants the right to write extended attributes.
FILE_EXECUTE (file)FILE_TRAVERSE (directory)
32 (0×20)
 Grants the right to execute a file. For a directory, the directory can be traversed.
FILE_DELETE_CHILD (directory)
64 (0×40)
 Grants the right to delete a directory and all the files it contains, even if the files are read-only.
FILE_READ_ATTRIBUTES
128 (0×80)
 Grants the right to read file attributes.
FILE_WRITE_ATTRIBUTES
256 (0×100)
 Grants the right to change file attributes.
DELETE
65536 (0×10000)
 Grants delete access.
READ_CONTROL
131072 (0×20000)
 Grants read access to the security descriptor and owner.
WRITE_DAC
262144 (0×40000)
 Grants write access to the discretionary ACL.
WRITE_OWNER
524288 (0×80000)
 Assigns the write owner.
SYNCHRONIZE
1048576 (0×100000)
 Synchronizes access and allows a process to wait for an object to enter the signaled state. 
function GetEffectivePermission(const FileName:string;Flags:integer):Boolean;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  Result:=FWbemObject.GetEffectivePermission(Flags);
end;

And use like this

GetEffectivePermission('C:\FooFolder\Foo_Filename.ext',FILE_READ_DATA or FILE_READ_ATTRIBUTES);

Getting the Status of a task

The functions Compress, UnCompress, Copy, Rename and Delete return a Result code which can be translated to a message using this function

function GetResultMessage(ResultCode:Integer) : string;
begin
  case ResultCode of
     0 : Result:='Success';
     2 : Result:='Access denied';
     8 : Result:='Unspecified failure';
     9 : Result:='Invalid object';
    10 : Result:='Object already exists';
    11 : Result:='File system not NTFS';
    12 : Result:='Platform not Windows NT or Windows 2000';
    13 : Result:='Drive not the same';
    14 : Result:='Directory not empty';
    15 : Result:='Sharing violation';
    16 : Result:='Invalid start file';
    17 : Result:='Privilege not held';
    21 : Result:='Invalid parameter'
  else
    Result := 'Unknown';
  end;
end;

Demo Application

Check this demo application which can list all the files and folders in a remote or local machine only using the WMI

Download the binaries and sourcecode from here

 


by 3 Comments

Two ways to get the command line of another process using delphi

Today I will show you how you can retrieve the Command line parameters of an external application from Delphi using the WinApi and the WMI. In order to understand how the Command line parameters are stored and treated by the system, I recommend which you read this article from  Raymond Chen .

The WinApi way

In order to get the command line from an external process using the WinAPI, you must access to the PEB (Process Environment Block) of the application. To get the PEB you can use the NtQueryInformationProcess function

NTSTATUS WINAPI NtQueryInformationProcess(
  __in       HANDLE ProcessHandle,
  __in       PROCESSINFOCLASS ProcessInformationClass,
  __out      PVOID ProcessInformation,
  __in       ULONG ProcessInformationLength,
  __out_opt  PULONG ReturnLength
);

 

function  NtQueryInformationProcess(
  ProcessHandle : THandle;
  ProcessInformationClass : DWORD;
  ProcessInformation : Pointer;
  ProcessInformationLength : ULONG;
  ReturnLength : PULONG
 ): LongInt; stdcall; external 'ntdll.dll';

Passing the ProcessBasicInformation value in the ProcessInformationClass parameter and a buffer to hold the PROCESS_BASIC_INFORMATION returned in the ProcessInformation.

This is the official (MSDN) definition for the PROCESS_BASIC_INFORMATION structure

typedef struct _PROCESS_BASIC_INFORMATION {
    PVOID Reserved1;
    PPEB PebBaseAddress;
    PVOID Reserved2[2];
    ULONG_PTR UniqueProcessId;
    PVOID Reserved3;
} PROCESS_BASIC_INFORMATION;

And this a more friendly delphi translation of this structure using the NTinterlnals.net site

  PROCESS_BASIC_INFORMATION = packed record
    ExitStatus: DWORD;
    PebBaseAddress: Pointer;
    AffinityMask: DWORD;
    BasePriority: DWORD;
    UniqueProcessId: DWORD;
    InheritedUniquePID:DWORD;
  end;

The key field in this structure is PebBaseAddress, which stores the address of the PEB. from this point now you must digging inside of the PEB structure again

typedef struct _PEB {
  BYTE                          Reserved1[2];
  BYTE                          BeingDebugged;
  BYTE                          Reserved2[1];
  PVOID                         Reserved3[2];
  PPEB_LDR_DATA                 Ldr;
  PRTL_USER_PROCESS_PARAMETERS  ProcessParameters;
  BYTE                          Reserved4[104];
  PVOID                         Reserved5[52];
  PPS_POST_PROCESS_INIT_ROUTINE PostProcessInitRoutine;
  BYTE                          Reserved6[128];
  PVOID                         Reserved7[1];
  ULONG                         SessionId;
} PEB, *PPEB;

and retrieve the value of the ProcessParameters field which is a pointer to a RTL_USER_PROCESS_PARAMETERS structure

typedef struct _RTL_USER_PROCESS_PARAMETERS {
  BYTE           Reserved1[16];
  PVOID          Reserved2[10];
  UNICODE_STRING ImagePathName;
  UNICODE_STRING CommandLine;
} RTL_USER_PROCESS_PARAMETERS, *PRTL_USER_PROCESS_PARAMETERS;

Finally you can note which the CommandLine field stores the info which are looking for.

The WinAPI Delphi Code

This is the Delphi source which retrieves the Command line parameters from an external application
Notes :

  1. the next code uses hard-coded offsets to read specific locations of the PEB to avoid the declaration the full structures required (feel free to declare these structures and avoid the offsets).
  2. this code only works for 32 bits process because the structure of the PEB differs from 32 to 64 processes.
  3. to gain access to the processes owned by the system the code set the  SeDebugPrivilege token before to use the OpenProcess function.
//Author Rodrigo Ruz V.
//2011-07-20
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;

type
  _UNICODE_STRING = record
    Length: Word;
    MaximumLength: Word;
    Buffer: LPWSTR;
  end;
  UNICODE_STRING = _UNICODE_STRING;

  PROCESS_BASIC_INFORMATION = packed record
    ExitStatus: DWORD;
    PebBaseAddress: Pointer;
    AffinityMask: DWORD;
    BasePriority: DWORD;
    UniqueProcessId: DWORD;
    InheritedUniquePID:DWORD;
  end;

  function  NtQueryInformationProcess(ProcessHandle : THandle; ProcessInformationClass : DWORD; ProcessInformation : Pointer; ProcessInformationLength : ULONG; ReturnLength : PULONG ): LongInt; stdcall; external 'ntdll.dll';

function GetCommandLineFromPid(PID: THandle): string;
const
  STATUS_SUCCESS             = $00000000;
  SE_DEBUG_NAME              = 'SeDebugPrivilege';
  OffsetProcessParametersx32 = $10;//16
  OffsetCommandLinex32       = $40;//64
var
  ProcessHandle        : THandle;
  rtlUserProcAddress   : Pointer;
  CommandLine          : UNICODE_STRING;
  CommandLineContents  : WideString;
  ProcessBasicInfo     : PROCESS_BASIC_INFORMATION;
  ReturnLength         : Cardinal;
  TokenHandle          : THandle;
  lpLuid               : TOKEN_PRIVILEGES;
  OldlpLuid            : TOKEN_PRIVILEGES;
begin
  Result:='';
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
  begin
    try

      if not LookupPrivilegeValue(nil, SE_DEBUG_NAME, lpLuid.Privileges[0].Luid) then
        RaiseLastOSError
      else
      begin
        lpLuid.PrivilegeCount := 1;
        lpLuid.Privileges[0].Attributes  := SE_PRIVILEGE_ENABLED;
        ReturnLength := 0;
        OldlpLuid    := lpLuid;
        //Set the SeDebugPrivilege privilege
        if not AdjustTokenPrivileges(TokenHandle, False, lpLuid, SizeOf(OldlpLuid), OldlpLuid, ReturnLength) then RaiseLastOSError;
      end;

      ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID);
      if ProcessHandle=0 then RaiseLastOSError
      else
      try
        // get the PROCESS_BASIC_INFORMATION to access to the PEB Address
        if (NtQueryInformationProcess(ProcessHandle,0{=>ProcessBasicInformation},@ProcessBasicInfo, sizeof(ProcessBasicInfo), @ReturnLength)=STATUS_SUCCESS) and (ReturnLength=SizeOf(ProcessBasicInfo)) then
        begin
          //get the address of the RTL_USER_PROCESS_PARAMETERS struture
          if not ReadProcessMemory(ProcessHandle, Pointer(Longint(ProcessBasicInfo.PEBBaseAddress) + OffsetProcessParametersx32), @rtlUserProcAddress, sizeof(Pointer), ReturnLength) then
            RaiseLastOSError
          else
          if ReadProcessMemory(ProcessHandle, Pointer(Longint(rtlUserProcAddress) + OffsetCommandLinex32), @CommandLine, sizeof(CommandLine), ReturnLength) then
          begin
            SetLength(CommandLineContents, CommandLine.length);
            //get the CommandLine field
            if ReadProcessMemory(ProcessHandle, CommandLine.Buffer, @CommandLineContents[1], CommandLine.Length, ReturnLength) then
             Result := WideCharLenToString(PWideChar(CommandLineContents), CommandLine.length div 2)
            else
            RaiseLastOSError;
          end;
        end
        else
        RaiseLastOSError;
      finally
        CloseHandle(ProcessHandle);
      end;
    finally
      CloseHandle(TokenHandle);
    end;
  end
  else
  RaiseLastOSError;
end;

begin
 try
   Writeln(GetCommandLineFromPid(5440));
 except
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Readln;
end.

The WMI way

The WMI provides a very reliable and easy way to access the Command line parameters from an external process, all you must to do is use the Win32_Process wmi class and look in the CommandLine property.

The WMI Delphi Code

Notes

  1. The next code can retrieve the command line for 32 and 64 bits processes.
  2. The code uses Late binding to access the WMI, if you want use another way to access the WMI from Delphi (like direct COM access or importing th e Microsoft scripting library) take a look to the Delphi WMI Code creator.
  3. You can change the credentials of the ConnectServer function to access to the command line parameters of a remote machine process.
{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  ActiveX,
  Variants,
  ComObj;

function  GetCommandLineFromPid(ProcessId:DWORD): string;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
begin;
  Result:='';
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  //if the pid not exist a EOleException exception will be raised with the code $80041002 - Object Not Found
  FWbemObjectSet:= FWMIService.Get(Format('Win32_Process.Handle="%d"',[ProcessId]));
  Result:=FWbemObjectSet.CommandLine;
end;

begin
 try
    CoInitialize(nil);
    try
     Writeln(GetCommandLineFromPid(5452));
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


by 7 Comments

Using Delphi and ADSI to enumerate local and remote shared resources

One of the most rich Directory Access Technologies of Microsoft is the Active Directory Service Interfaces (ADSI) which is a set of interfaces designed to access the features of directory services from different network providers, in this case we will use the WinNT Provider to access the shared resources of a local or remote machine.  The aim of this post is show you how you can obtain the information related to the shared resources from a Delphi application.

Getting the interfaces

The common way to access the ADSI Interfaces from Delphi is importing the Active DS type library.

After of import the type library you will got a large unit file with many interfaces , constants and types which we will not need in this case, and only increase the final size of our application. So we can extract the interfaces for access the network shared resources (see the next source that shows the interfaces to the task)

const
  IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
  IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
  ADS_SECURE_AUTHENTICATION = $00000001;
type
  IADsCollection = interface(IDispatch)
    ['{72B945E0-253B-11CF-A988-00AA006BC149}']
    function Get__NewEnum: IUnknown; safecall;
    procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
    procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
    function GetObject(const bstrName: WideString): OleVariant; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
  end;

  IADs = interface(IDispatch)
    ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
    function Get_Name: WideString; safecall;
    function Get_Class_: WideString; safecall;
    function Get_GUID: WideString; safecall;
    function Get_ADsPath: WideString; safecall;
    function Get_Parent: WideString; safecall;
    function Get_Schema: WideString; safecall;
    procedure GetInfo; safecall;
    procedure SetInfo; safecall;
    function Get(const bstrName: WideString): OleVariant; safecall;
    procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
    function GetEx(const bstrName: WideString): OleVariant; safecall;
    procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
    procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
    property Name: WideString read Get_Name;
    property Class_: WideString read Get_Class_;
    property GUID: WideString read Get_GUID;
    property ADsPath: WideString read Get_ADsPath;
    property Parent: WideString read Get_Parent;
    property Schema: WideString read Get_Schema;
  end;

  IADsContainer = interface(IDispatch)
    ['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
    function Get_Count: Integer; safecall;
    function Get__NewEnum: IUnknown; safecall;
    function Get_Filter: OleVariant; safecall;
    procedure Set_Filter(pVar: OleVariant); safecall;
    function Get_Hints: OleVariant; safecall;
    procedure Set_Hints(pvFilter: OleVariant); safecall;
    function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
    function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    property Count: Integer read Get_Count;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Filter: OleVariant read Get_Filter write Set_Filter;
    property Hints: OleVariant read Get_Hints write Set_Hints;
  end;

  IADsServiceOperations = interface(IADs)
    ['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
    function Get_Status: Integer; safecall;
    procedure Start; safecall;
    procedure Stop; safecall;
    procedure Pause; safecall;
    procedure Continue; safecall;
    procedure SetPassword(const bstrNewPassword: WideString); safecall;
    property Status: Integer read Get_Status;
  end;

  IADsFileServiceOperations = interface(IADsServiceOperations)
    ['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
    function Sessions: IADsCollection; safecall;
    function Resources: IADsCollection; safecall;
  end;

  IADsResource = interface(IADs)
    ['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Path: WideString; safecall;
    function Get_LockCount: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Path: WideString read Get_Path;
    property LockCount: Integer read Get_LockCount;
  end;

  IADsSession = interface(IADs)
    ['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Computer: WideString; safecall;
    function Get_ComputerPath: WideString; safecall;
    function Get_ConnectTime: Integer; safecall;
    function Get_IdleTime: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Computer: WideString read Get_Computer;
    property ComputerPath: WideString read Get_ComputerPath;
    property ConnectTime: Integer read Get_ConnectTime;
    property IdleTime: Integer read Get_IdleTime;
  end;

  IADsFileShare = interface(IADs)
    ['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
    function Get_CurrentUserCount: Integer; safecall;
    function Get_Description: WideString; safecall;
    procedure Set_Description(const retval: WideString); safecall;
    function Get_HostComputer: WideString; safecall;
    procedure Set_HostComputer(const retval: WideString); safecall;
    function Get_Path: WideString; safecall;
    procedure Set_Path(const retval: WideString); safecall;
    function Get_MaxUserCount: Integer; safecall;
    procedure Set_MaxUserCount(retval: Integer); safecall;
    property CurrentUserCount: Integer read Get_CurrentUserCount;
    property Description: WideString read Get_Description write Set_Description;
    property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
    property Path: WideString read Get_Path write Set_Path;
    property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
  end;

In addition to the interfaces we need the ADsOpenObject function which allow you binds to an ADSI interface.

check the syntax of this function

HRESULT ADsOpenObject(
  __in   LPCWSTR lpszPathName,
  __in   LPCWSTR lpszUserName,
  __in   LPCWSTR lpszPassword,
  __in   DWORD dwReserved,
  __in   REFIID riid,
  __out  VOID **ppObject
);

The Delphi equivalent can be

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;
dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; safecall; external 'activeds.dll';

or

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;
dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';

As you can see the only difference is the calling convention (safecall vs stdcall), if you want which Delphi check the value of the returned HResult and raises the exception for you then use the safecall calling convention else if you want check manually the HResult returned by the function use stdcall

Listing the Connected Sessions

To list the Open Sessions (Machines connected) to the shared resources we must use the IADsFileServiceOperations interface and the Sessions function which return a collection of the open sessions for the service.

const
   lpszUserName ='';  // set the user name used to establish the connection to the remote machine
   lpszPassword ='';  // set the password used to establish the connection to the remote machine
   lpszComputer ='.'; // the "." is for the local machine, you can set the name of the remote machine
var
  FSO             : IADsFileServiceOperations;
  Sessions        : IADsCollection;
  Session         : IADsSession;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
  dt              : TDateTime;
begin
  //connect to the file service of the loal o remote machine
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  //obtain the sessions
  Sessions := FSO.Sessions;
  //Get the enumerator
  oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element to IADsSession
    Session:=IUnknown(rgvar) as IADsSession;
    try
      Writeln('Computer        '+Session.Computer);
      dt := Session.ConnectTime / SecsPerDay; // the ConnectTime  property return the value in seconds
      Writeln('Connected Time  '+FormatDateTime('hh:nn:ss',dt));
      dt := Session.IdleTime / SecsPerDay; // the IdleTime property return the value in seconds
      Writeln('Idle Time       '+FormatDateTime('hh:nn:ss',dt));
      Writeln('Name            '+Session.Name);
      Writeln('User            '+Session.User);
      Writeln('');
    finally
      rgvar:=Unassigned; //clear the variant used for hold the values avoiding meory leaks
    end;
  end;
end;

With this simple code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Sessions

Listing the shared resources in use (opened)

To List the opened resources like folders and files we must use the IADsFileServiceOperations interface and the Resources function which return a collection of the open resources for the service.

procedure ListSharedResourcesInUse;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Resources       : IADsCollection;
  Resource        : IADsResource;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  //connect to the WinNt provider of the local or remote machine and get an instance to the file service
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  //Get the opened resources
  Resources := FSO.Resources;
  //get the enumerator
  oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element of the collection to the IADsResource interface
    Resource:=IUnknown(rgvar) as IADsResource;
    try
      try
       Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
      except
        on E:EOleException  do
        if E.ErrorCode<> HResult($80070002) then  //in some cases this exception (path not found) is raised when you enumerate the opened resources, you can ignore without problems
         raise;
      end;
    finally
      rgvar:=Unassigned; //avoid a memory leak
    end;
  end;
end;

With this code you will get the same information returned by the Windows option Computer Management -> System Tools -> Shared folders > Open files

Listing the Shared Resources

Finally to List the shared resources we must connect to the local or remote machine using the ADsOpenObject function passing a IADsContainer interface which return a collection with the resources.

procedure ListShared;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  Shares          : IADsContainer;
  Share           : IADsFileShare;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  //connect to the network provider and get the collection of shared resources
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
  //get the enumerator
  oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    //cast the current element to IADsFileShare
    Share:=IUnknown(rgvar) as IADsFileShare;
    try
      Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
      Writeln('Host Computer    '+Share.HostComputer);
      Writeln('Description      '+Share.Description);
      Writeln('Path             '+Share.Path);
      Writeln('Max User Count   '+IntToStr(Share.MaxUserCount));
      Writeln('');
    finally
     rgvar:=Unassigned; //avoid memory leaks
    end;
  end;
end;

The Console application

This is the full source code of a console application to show all the tasks described in this post.

{$APPTYPE CONSOLE}
{.$DEFINE USE_ActiveDs_TLB}

uses
  {$IFDEF USE_ActiveDs_TLB}
  ActiveDs_TLB,
  {$ENDIF}
  Windows,
  ComObj,
  Variants,
  ActiveX,
  SysUtils;

{$IFNDEF USE_ActiveDs_TLB}
const
  IID_IADsContainer: TGUID = '{001677D0-FD16-11CE-ABC4-02608C9E7553}';
  IID_IADsFileServiceOperations: TGUID = '{A02DED10-31CA-11CF-A98A-00AA006BC149}';
  ADS_SECURE_AUTHENTICATION = $00000001;
type
  IADsCollection = interface(IDispatch)
    ['{72B945E0-253B-11CF-A988-00AA006BC149}']
    function Get__NewEnum: IUnknown; safecall;
    procedure Add(const bstrName: WideString; vItem: OleVariant); safecall;
    procedure Remove(const bstrItemToBeRemoved: WideString); safecall;
    function GetObject(const bstrName: WideString): OleVariant; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
  end;

  IADs = interface(IDispatch)
    ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
    function Get_Name: WideString; safecall;
    function Get_Class_: WideString; safecall;
    function Get_GUID: WideString; safecall;
    function Get_ADsPath: WideString; safecall;
    function Get_Parent: WideString; safecall;
    function Get_Schema: WideString; safecall;
    procedure GetInfo; safecall;
    procedure SetInfo; safecall;
    function Get(const bstrName: WideString): OleVariant; safecall;
    procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
    function GetEx(const bstrName: WideString): OleVariant; safecall;
    procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
    procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
    property Name: WideString read Get_Name;
    property Class_: WideString read Get_Class_;
    property GUID: WideString read Get_GUID;
    property ADsPath: WideString read Get_ADsPath;
    property Parent: WideString read Get_Parent;
    property Schema: WideString read Get_Schema;
  end;

  IADsContainer = interface(IDispatch)
    ['{001677D0-FD16-11CE-ABC4-02608C9E7553}']
    function Get_Count: Integer; safecall;
    function Get__NewEnum: IUnknown; safecall;
    function Get_Filter: OleVariant; safecall;
    procedure Set_Filter(pVar: OleVariant); safecall;
    function Get_Hints: OleVariant; safecall;
    procedure Set_Hints(pvFilter: OleVariant); safecall;
    function GetObject(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    function Create(const ClassName: WideString; const RelativeName: WideString): IDispatch; safecall;
    procedure Delete(const bstrClassName: WideString; const bstrRelativeName: WideString); safecall;
    function CopyHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    function MoveHere(const SourceName: WideString; const NewName: WideString): IDispatch; safecall;
    property Count: Integer read Get_Count;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Filter: OleVariant read Get_Filter write Set_Filter;
    property Hints: OleVariant read Get_Hints write Set_Hints;
  end;

  IADsServiceOperations = interface(IADs)
    ['{5D7B33F0-31CA-11CF-A98A-00AA006BC149}']
    function Get_Status: Integer; safecall;
    procedure Start; safecall;
    procedure Stop; safecall;
    procedure Pause; safecall;
    procedure Continue; safecall;
    procedure SetPassword(const bstrNewPassword: WideString); safecall;
    property Status: Integer read Get_Status;
  end;

  IADsFileServiceOperations = interface(IADsServiceOperations)
    ['{A02DED10-31CA-11CF-A98A-00AA006BC149}']
    function Sessions: IADsCollection; safecall;
    function Resources: IADsCollection; safecall;
  end;

  IADsResource = interface(IADs)
    ['{34A05B20-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Path: WideString; safecall;
    function Get_LockCount: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Path: WideString read Get_Path;
    property LockCount: Integer read Get_LockCount;
  end;

  IADsSession = interface(IADs)
    ['{398B7DA0-4AAB-11CF-AE2C-00AA006EBFB9}']
    function Get_User: WideString; safecall;
    function Get_UserPath: WideString; safecall;
    function Get_Computer: WideString; safecall;
    function Get_ComputerPath: WideString; safecall;
    function Get_ConnectTime: Integer; safecall;
    function Get_IdleTime: Integer; safecall;
    property User: WideString read Get_User;
    property UserPath: WideString read Get_UserPath;
    property Computer: WideString read Get_Computer;
    property ComputerPath: WideString read Get_ComputerPath;
    property ConnectTime: Integer read Get_ConnectTime;
    property IdleTime: Integer read Get_IdleTime;
  end;

  IADsFileShare = interface(IADs)
    ['{EB6DCAF0-4B83-11CF-A995-00AA006BC149}']
    function Get_CurrentUserCount: Integer; safecall;
    function Get_Description: WideString; safecall;
    procedure Set_Description(const retval: WideString); safecall;
    function Get_HostComputer: WideString; safecall;
    procedure Set_HostComputer(const retval: WideString); safecall;
    function Get_Path: WideString; safecall;
    procedure Set_Path(const retval: WideString); safecall;
    function Get_MaxUserCount: Integer; safecall;
    procedure Set_MaxUserCount(retval: Integer); safecall;
    property CurrentUserCount: Integer read Get_CurrentUserCount;
    property Description: WideString read Get_Description write Set_Description;
    property HostComputer: WideString read Get_HostComputer write Set_HostComputer;
    property Path: WideString read Get_Path write Set_Path;
    property MaxUserCount: Integer read Get_MaxUserCount write Set_MaxUserCount;
  end;
{$ENDIF}

function ADsOpenObject(lpszPathName,lpszUserName,lpszPassword : WideString;dwReserved : DWORD; const riid:TGUID; out ppObject): HResult; stdcall; external 'activeds.dll';

procedure ListConnectedSessions;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Sessions        : IADsCollection;
  Session         : IADsSession;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
  dt              : TDateTime;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  Sessions := FSO.Sessions;
  oEnum:= IUnknown(Sessions._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Session:=IUnknown(rgvar) as IADsSession;
    try
      Writeln('Computer        '+Session.Computer);
      dt := Session.ConnectTime / SecsPerDay;
      Writeln('Connected Time  '+FormatDateTime('hh:nn:ss',dt));
      dt := Session.IdleTime / SecsPerDay;
      Writeln('Idle Time       '+FormatDateTime('hh:nn:ss',dt));
      Writeln('Name            '+Session.Name);
      Writeln('User            '+Session.User);
      Writeln('');
    finally
      rgvar:=Unassigned;
    end;
  end;
end;

procedure ListSharedResourcesInUse;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  FSO             : IADsFileServiceOperations;
  Resources       : IADsCollection;
  Resource        : IADsResource;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsFileServiceOperations,FSO));
  Resources := FSO.Resources;
  oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Resource:=IUnknown(rgvar) as IADsResource;
    try
      try
       Writeln(Format('Resource %s User %s LockCount %d',[Resource.Path, Resource.User, Resource.LockCount]));
      except
        on E:EOleException  do
        if E.ErrorCode<> HResult($80070002) then  //ignore path not found exception
         raise;
      end;
    finally
      rgvar:=Unassigned;
    end;

  end;
end;

procedure ListShared;
const
   lpszUserName ='';
   lpszPassword ='';
   lpszComputer ='.';
var
  Shares          : IADsContainer;
  Share           : IADsFileShare;
  rgvar           : OleVariant;
  pceltFetched    : Cardinal;
  oEnum           : IEnumvariant;
begin
  OleCheck(ADsOpenObject(Format('WinNT://%s/LanmanServer',[lpszComputer]), lpszUserName, lpszPassword, ADS_SECURE_AUTHENTICATION,IID_IADsContainer,Shares));
  oEnum:= IUnknown(Shares._NewEnum) as IEnumVariant;
  while oEnum.Next(1, rgvar, pceltFetched) = 0 do
  begin
    Share:=IUnknown(rgvar) as IADsFileShare;
    try
      Writeln('CurrentUserCount '+IntToStr(Share.CurrentUserCount));
      Writeln('Host Computer    '+Share.HostComputer);
      Writeln('Description      '+Share.Description);
      Writeln('Path             '+Share.Path);
      Writeln('Max User Count   '+IntToStr(Share.MaxUserCount));
      Writeln('');
    finally
     rgvar:=Unassigned;
    end;
  end;
end;

begin
 try
    CoInitialize(nil);
    try
      ListSharedResourcesInUse;
      ListConnectedSessions;
      ListShared;
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException  do
        Writeln(Format('EOleException %s Code %x',[E.Message,E.ErrorCode]));
    on E:EOleSysError  do
        Writeln(Format('EOleSysError  %s Code %x',[E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.


by 4 Comments

Using the Google Safe Browsing API from Delphi

The Google Safe Browsing API is a service that enables applications to check URLs against the Google’s lists of suspected phishing and malware pages. Exist two types of APIs for using the Safe Browsing service, Safe Browsing API v2 and Safe Browsing Lookup API in this article I will show how use the Safe Browsing Lookup API from a Delphi application.

The Safe Browsing Lookup API is designed to provide a simple interface through HTTP GET or POST request and get the state of the URL(s) directly from the server.

Like most of the services provided by Google you need to request an API key. In order to obtain an API key you must log in with your existing Google account and sign up for the API at http://www.google.com/safebrowsing/key_signup.html

Using the GET Method

The Get method  allow to the client only lookup one URL per request. To use the GET method you must make a request to this URL


https://sb-ssl.google.com/safebrowsing/api/lookup?client=CLIENT&apikey=APIKEY&appver=APPVER&pver=PVER&url=URL

Parameters

  • The client parameter indicates the type of client, it could be any name of the client’s choice.
  • The apikey parameter indicates the API key.
  • The appver parameter indicates the version of the client.
  • The pver parameter indicates the protocol version that the client supports. Currently this should be “3.0″. The format is “major.minor”. If we update the protocol, we will make sure that minor revisions are always compatible; however major revision will be incompatible and the server MAY NOT be able to cope with an older protocol.
  • The url parameter indicates the url the client wants to lookup. It must be a valid URL (non ASCII characters must be in UTF-8) and needs to be encoded properly to avoid confusion. For example, if the url contains ‘&’, it could be interpreted as the separator of the CGI parameters. We require the API users to use the percent encoding for the set of “reserved characters”, which is defined in RFC 3986 . A summary of the percent encoding can be found here.

Check this Sample Url


https://sb-ssl.google.com/safebrowsing/api/lookup?client=mydemoapp&<strong>apikey</strong>=1234567890&appver=1.0.1&pver=3.0&url=http%3A%2F%2Fwww.google.com%2F

In this case the values passed are

client = mydemoapp
apikey = 1234567890
appver = 1.0.1
pver   = 3.0
url    = http://www.google.com

Response

The service returns the following HTTP response codes for the GET method

  • 200: The queried URL is either phishing, malware or both, see the response body for the specific type.
  • 204: The requested URL is legitimate, no response body returned.
  • 400: Bad Request — The HTTP request was not correctly formed.
  • 401: Not Authorized — The apikey is not authorized
  • 503: Service Unavailable .

Additionally  the server will include the actual type of URL in the response body when the queried URL matches either the phishing or malware lists, so the body will contain one of these values
“phishing” | “malware” | “phishing,malware"

Delphi Code for the GET Request

The next source uses the Wininet functions to make the GET request, feel free to use another components like Indy or synapse to accomplish this task.

{$APPTYPE CONSOLE}
uses
  Classes,
  Windows,
  WinInet,
  SysUtils;
const
  sUserAgent = 'Mozilla/5.001 (windows; U; NT4.0; en-US; rv:1.0) Gecko/25250101';
  //¡¡¡¡¡¡¡¡¡¡Please be nice and use your own API key, get a key from here http://code.google.com/apis/safebrowsing/key_signup.html ¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡
  sApiKey    = 'ABQIAAAAzY4CKjsBFYV4Rxx0ZQaKlxQL2a1oqOk9I7UVXAZVtWa6uSA2XA';
  sServer    = 'sb-ssl.google.com';
  sGetSafeBrowsing   = '/safebrowsing/api/lookup?client=delphi&apikey=%s&appver=1.5.2&pver=3.0&url=%s';

//this function translate a WinInet Error Code to a description of the error.
function GetWinInetError(ErrorCode:Cardinal): string;
const
   winetdll = 'wininet.dll';
var
  Len: Integer;
  Buffer: PChar;
begin
  Len := FormatMessage(
  FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_FROM_SYSTEM or
  FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS or  FORMAT_MESSAGE_ARGUMENT_ARRAY,
  Pointer(GetModuleHandle(winetdll)), ErrorCode, 0, @Buffer, SizeOf(Buffer), nil);
  try
    while (Len > 0) and {$IFDEF UNICODE}(CharInSet(Buffer[Len - 1], [#0..#32, '.'])) {$ELSE}(Buffer[Len - 1] in [#0..#32, '.']) {$ENDIF} do Dec(Len);
    SetString(Result, Buffer, Len);
  finally
    LocalFree(HLOCAL(Buffer));
  end;
end;

//make a GET request using the WinInet functions
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:='';
  hInet := InternetOpen(PChar(sUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if hInet=nil then
  begin
    ErrorCode:=GetLastError;
    raise Exception.Create(Format('InternetOpen Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
  end;

  try
    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;

          lpdwBufferLength:=SizeOf(Result);
          lpdwReserved    :=0;
          //get the status code
          if not HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, lpdwBufferLength, lpdwReserved) then
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('HttpQueryInfo Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

         if Result=200 then //read the body response in case which the status code is 200
          if InternetQueryDataAvailable(hRequest, lpdwNumberOfBytesAvailable, 0, 0) then
          begin
            GetMem(lpvBuffer,lpdwBufferLength);
            try
              SetLength(Response,lpdwNumberOfBytesAvailable);
              InternetReadFile(hRequest, @Response[1], lpdwNumberOfBytesAvailable, dwBytesRead);
            finally
              FreeMem(lpvBuffer);
            end;
          end
          else
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('InternetQueryDataAvailable Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

      finally
        InternetCloseHandle(hRequest);
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
end;

//encode a Url
function URLEncode(const Url: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Url) do
  begin
    case Url[i] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.':
        Result := Result + Url[i];
    else
        Result := Result + '%' + IntToHex(Ord(Url[i]), 2);
    end;
  end;
end;

//Send The GET request and process the returned body
Procedure TestGet(const AUrl : string);
var
 Response     : AnsiString;
 ResponseCode : Integer;
begin
   ResponseCode:=Https_Get(sServer,Format(sGetSafeBrowsing,[sApiKey,URLEncode(AUrl)]), Response);
   case ResponseCode of
     200: Writeln(Format('The queried URL (%s) is %s',[AUrl,Response]));
     204: Writeln(Format('The queried URL (%s) is %s',[AUrl,'legitimate']));
     400: Writeln('Bad Request — The HTTP request was not correctly formed.');
     401: Writeln('Not Authorized — The apikey is not authorized');
     503: Writeln('Service Unavailable — The server cannot handle the request.');
   else
         Writeln('Unknow response');
   end;
end;

begin
  try
     //Now check some urls.
     TestGet('http://malware.testing.google.test/testing/malware/');
     TestGet('orgsite.info');
     TestGet('http://www.google.com');
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

This will return

The queried URL (http://malware.testing.google.test/testing/malware/) is malware
The queried URL (orgsite.info) is malware
The queried URL (http://www.google.com) is legitimate

Using the POST Method

The post request is more powerful because the client can also look up a set of URLs (up to 500) through HTTP POST request. To use the POST method you must make a request to this URL


https://sb-ssl.google.com/safebrowsing/api/lookup?client=CLIENT&apikey=APIKEY&appver=APPVER&pver=PVER

Parameters

  • The client parameter indicates the type of client, it could be any name of the client’s choice.
  • The apikey parameter indicates the API key.
  • The appver parameter indicates the version of the client.
  • The pver parameter indicates the protocol version that the client supports.

Check this Sample Url


https://sb-ssl.google.com/safebrowsing/api/lookup?client=mydemoapp&<strong>apikey</strong>=1234567890&appver=1.0.1&pver=3.0

Request Body

The client specifies the queried URLs in the POST request body using the following format:
POST_REQ_BODY = NUM LF URL (LF URL)*
NUM = (DIGIT)+
URL = url string following the RFC 1738
The request’s body contains several lines separated by LF. The first line is a number indicating how many URLs are included in the body. The next several lines are URLs to be looked up. Each line contains one URL and the client must specify at least one URL in the body.

check this sample

2

http://www.google.com/

http://malware.testing.google.test/testing/malware/

Response

The server generates the following HTTP response codes for the POST request:

  • 200: AT LEAST ONE of the queried URLs are matched in either the phishing or malware lists, the actual results are returned through the response body
  • 204: NONE of the queried URLs matched the phishing or malware lists, no response body returned
  • 400: Bad Request — The HTTP request was not correctly formed
  • 401: Not Authorized.
  • 503: Service Unavailable.

Body

In the POST request, the server will return a list of  URLs queried in the response body when at least one of the queried URLs matches in the suspected phishing or malware lists.
POST_RESP_BODY = VERDICT (LF VERDICT)*
VERDICT = “phishing” | “malware” | “phishing,malware” | “ok”

The type has the same meaning as in the GET response body except that some of the URLs may be legitimate (recall that the server returns empty content only when none of the queried URLs matches the phishing or malware lists). In this case, we return “ok” for the non-matching URLs. The results are separated by the LF. There is a one-on-one mapping between the results in the response body and the queried URLs in the request body. For example, assume there are 10 URLs specified in the request body, the server will return exactly 10 results with the original order. That is, the first line corresponds to the result of the first queried URL, the second line corresponds to the result of the second queried URL, and so on.

Delphi Code for the POST Request

{$APPTYPE CONSOLE}
uses
  Classes,
  Windows,
  WinInet,
  SysUtils;

const
  sUserAgent = 'Mozilla/5.001 (windows; U; NT4.0; en-US; rv:1.0) Gecko/25250101';
  //¡¡¡¡¡¡¡¡¡¡Please be nice and use your own API key, get a key from here http://code.google.com/apis/safebrowsing/key_signup.html ¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡
  sApiKey    = 'ABQIAAAAzY4CKjsBFYV4Rxx0ZQaKlxQL2a1oqOk9I7UVXAZVtWa6uSA2XA';
  sServer    = 'sb-ssl.google.com';
  sPostSafeBrowsing  = '/safebrowsing/api/lookup?client=delphi&apikey=%s&appver=1.5.2&pver=3.0';

function GetWinInetError(ErrorCode:Cardinal): string;
const
   winetdll = 'wininet.dll';
var
  Len: Integer;
  Buffer: PChar;
begin
  Len := FormatMessage(
  FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_FROM_SYSTEM or
  FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS or  FORMAT_MESSAGE_ARGUMENT_ARRAY,
  Pointer(GetModuleHandle(winetdll)), ErrorCode, 0, @Buffer, SizeOf(Buffer), nil);
  try
    while (Len > 0) and {$IFDEF UNICODE}(CharInSet(Buffer[Len - 1], [#0..#32, '.'])) {$ELSE}(Buffer[Len - 1] in [#0..#32, '.']) {$ENDIF} do Dec(Len);
    SetString(Result, Buffer, Len);
  finally
    LocalFree(HLOCAL(Buffer));
  end;
end;

function Https_Post(const ServerName,Resource: String;const PostData : AnsiString;Var Response:AnsiString): Integer;
const
  BufferSize=1024*64;
var
  hInet    : HINTERNET;
  hConnect : HINTERNET;
  hRequest : HINTERNET;
  ErrorCode : Integer;
  lpdwBufferLength: DWORD;
  lpdwReserved    : DWORD;
  dwBytesRead     : DWORD;
  lpdwNumberOfBytesAvailable: DWORD;
begin
  Result  :=0;
  Response:='';
  hInet := InternetOpen(PChar(sUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if hInet=nil then
  begin
    ErrorCode:=GetLastError;
    raise Exception.Create(Format('InternetOpen Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
  end;

  try
    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
      hRequest := HttpOpenRequest(hConnect, 'POST', 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 post request
        if not HTTPSendRequest(hRequest, nil, 0, @PostData[1], Length(PostData)) then
        begin
          ErrorCode:=GetLastError;
          raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
        end;

          lpdwBufferLength:=SizeOf(Result);
          lpdwReserved    :=0;
          //get the response code
          if not HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, lpdwBufferLength, lpdwReserved) then
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('HttpQueryInfo Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

         //if the response code =200 then get the body
         if Result=200 then
          if InternetQueryDataAvailable(hRequest, lpdwNumberOfBytesAvailable, 0, 0) then
          begin
            SetLength(Response,lpdwNumberOfBytesAvailable);
            InternetReadFile(hRequest, @Response[1], lpdwNumberOfBytesAvailable, dwBytesRead);
          end
          else
          begin
            ErrorCode:=GetLastError;
            raise Exception.Create(Format('InternetQueryDataAvailable Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
          end;

      finally
        InternetCloseHandle(hRequest);
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
end;

function URLEncode(const Url: string): string;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(Url) do
  begin
    case Url[i] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.':
        Result := Result + Url[i];
    else
        Result := Result + '%' + IntToHex(Ord(Url[i]), 2);
    end;
  end;
end;

Procedure TestPost(const UrlList : Array of AnsiString);
var
 Response     : AnsiString;
 ResponseCode : Integer;
 Data         : AnsiString;
 i            : integer;
 LstUrl       : TStringList;
begin
   //create the body request with the url to lookup
   Data:=AnsiString(IntToStr(Length(UrlList)))+#10;
   for i:= low(UrlList) to high(UrlList) do
     Data:=Data+UrlList[i]+#10;

   //make the post request
   ResponseCode:=Https_Post(sServer,Format(sPostSafeBrowsing,[sApiKey]), Data, Response);

   //process the response
   case ResponseCode of
     200:
          begin
             LstUrl:=TStringList.Create;
             try
               LstUrl.Text:=string(Response);
                for i:=0 to  LstUrl.Count-1  do
                 Writeln(Format('The queried URL (%s) is %s',[UrlList[i],LstUrl[i]]));

             finally
               LstUrl.Free;
             end;
          end;
     204: Writeln('NONE of the queried URLs matched the phishing or malware lists, no response body returned');
     400: Writeln('Bad Request — The HTTP request was not correctly formed.');
     401: Writeln('Not Authorized — The apikey is not authorized');
     503: Writeln('Service Unavailable — The server cannot handle the request.');
   else
         Writeln(Format('Unknow response Code (%d)',[ResponseCode]));
   end;
end;

begin
  try
     //check these three urls at once
     TestPost(['orgsite.info','http://www.google.com','http://malware.testing.google.test/testing/malware/']);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

finally the result will be

The queried URL (orgsite.info) is malware
The queried URL (http://www.google.com) is ok
The queried URL (http://malware.testing.google.test/testing/malware/) is malware


by 1 Comment

Delphi IDE Theme Editor – Now supports Lazarus

The Delphi IDE Theme Editor now supports the Lazarus IDE , so you can use any of the themes included in the installer or make your own theme. you can add the themes to the Lazarus IDE coping the generated themes (check  the Themes Lazarus folder in the installation path or download  the included Lazarus themes from here) to the primary_conf_path/userschemes/   folder (example in windows vista the folder is C:\Users\<Windows User>\AppData\Local\lazarus\userschemes) or let to the tool apply the current theme to Lazarus IDE.

For more information about the Lazarus color schemes check these articles

ScreenShots

Follow

Get every new post delivered to your Inbox.

Join 401 other followers