Thursday, March 25, 2010

How to get archive type

Have you ever find yourself in need to get the type of a archive? I don't know about you but I found myself in this situation a few times, therefore last time I said: That's enough lemme write a unit which does just that, 169 lines of code does exactly what I need and it does very well, I can now detect 12 archive types of most used compression routines.
As most of you know, each file type has some signature in the header(first few bytes in the file). Without anymore chit-chat here's the source that makes it all happen:
uDGArchiveType.pas
{******************************************************************************}
{                                                                              }
{   Unit: uDGArchiveType.pas                                                   }
{                                                                              }
{   Scope: archive type detection                                              }
{                                                                              }
{   Copyright© Dorin Duminica                                                  }
{                                                                              }
{******************************************************************************}
unit uDGArchiveType;

interface

uses
  SysUtils,
  Classes;

type
  TDGArchiveSignature = type Cardinal;

const
  szDGArchiveSignature = SizeOf(TDGArchiveSignature);

type
  TDGArchiveType = (
    atUnknown,
    atZip,
    atGZip,
    atCab,
    atRar,
    at7Zip,
    atBZip2,
    atARC,
    atQuad,
    atTar,
    atPAQ,
    atPEA);

type
  TDGArchiveTypeRec = record
    ArchiveType: TDGArchiveType;
    Signature: TDGArchiveSignature;
    Name: string;
  end; // TDGArchiveTypeRec = record

const
  CARCHIVESIGNATURE_UNKNOWN = 0;
  CARCHIVESIGNATURE_ZIP = $04034B50; // 0x04034B50
  CARCHIVESIGNATURE_GZIP = $08088B1F; // 0x08088B1F
  CARCHIVESIGNATURE_CAB = $4643534D; // 0x4643534D
  CARCHIVESIGNATURE_RAR = $21726152; // 0x21726152
  CARCHIVESIGNATURE_7ZIP = 2948364855;
  CARCHIVESIGNATURE_BZIP2 = $39685A42; // 0x39685A42
  CARCHIVESIGNATURE_ARC = $01437241; // 0x01437241
  CARCHIVESIGNATURE_QUAD = $0002A1BA; // 0x0002A1BA
  CARCHIVESIGNATURE_TAR = $65706957; // 0x65706957
  CARCHIVESIGNATURE_PAQ = $38716170; // 0x38716170
  CARCHIVESIGNATURE_PEA = $130001EA; // 0x130001EA

const
  CARCHIVENAME_UNKNOWN = 'Unknown';
  CARCHIVENAME_ZIP = 'Zip';
  CARCHIVENAME_GZIP = 'GZip';
  CARCHIVENAME_CAB = 'Cabinet';
  CARCHIVENAME_RAR = 'Rar';
  CARCHIVENAME_7ZIP = '7Zip';
  CARCHIVENAME_BZIP2 = 'BZip2';
  CARCHIVENAME_ARC = 'Arc';
  CARCHIVENAME_QUAD = 'Quad/Balz';
  CARCHIVENAME_TAR = 'Tar';
  CARCHIVENAME_PAQ = 'PAQ';
  CARCHIVENAME_PEA = 'PEA';

const
  CARCHIVE_COUNT = 12;

const
  CARCHIVE_TYPES: array[0..CARCHIVE_COUNT -1] of TDGArchiveTypeRec = (
    (ArchiveType: atUnknown; Signature: 0; Name: CARCHIVENAME_UNKNOWN),
    (ArchiveType: atZip; Signature: CARCHIVESIGNATURE_ZIP; Name: CARCHIVENAME_ZIP),
    (ArchiveType: atGZip; Signature: CARCHIVESIGNATURE_GZIP; Name: CARCHIVENAME_GZIP),
    (ArchiveType: atCab; Signature: CARCHIVESIGNATURE_CAB; Name: CARCHIVENAME_CAB),
    (ArchiveType: atRar; Signature: CARCHIVESIGNATURE_RAR; Name: CARCHIVENAME_RAR),
    (ArchiveType: at7Zip; Signature: CARCHIVESIGNATURE_7ZIP; Name: CARCHIVENAME_7ZIP),
    (ArchiveType: atBZip2; Signature: CARCHIVESIGNATURE_BZIP2; Name: CARCHIVENAME_BZIP2),
    (ArchiveType: atARC; Signature: CARCHIVESIGNATURE_ARC; Name: CARCHIVENAME_ARC),
    (ArchiveType: atQuad; Signature: CARCHIVESIGNATURE_QUAD; Name: CARCHIVENAME_QUAD),
    (ArchiveType: atTar; Signature: CARCHIVESIGNATURE_TAR; Name: CARCHIVENAME_TAR),
    (ArchiveType: atPAQ; Signature: CARCHIVESIGNATURE_PAQ; Name: CARCHIVENAME_PAQ),
    (ArchiveType: atPEA; Signature: CARCHIVESIGNATURE_PEA; Name: CARCHIVENAME_PEA)
  ); // CARCHIVE_TYPES: array[0..CARCHIVE_COUNT -1] of TDGArchiveTypeRec = (

function GetArchiveSignature(const FileName: string): TDGArchiveSignature; OVERLOAD;
function GetArchiveSignature(Stream: TStream): TDGArchiveSignature; OVERLOAD;
function GetArchiveTypeRec(Signature: TDGArchiveSignature): TDGArchiveTypeRec;
function GetArchiveType(const FileName: string): TDGArchiveType; OVERLOAD;
function GetArchiveType(Strean: TStream): TDGArchiveType; OVERLOAD;
function GetArchiveName(const FileName: string): string; OVERLOAD;
function GetArchiveName(Stream: TStream): string; OVERLOAD;
function GetArchiveTypeSignature(ArchiveType: TDGArchiveType): TDGArchiveSignature;

implementation

function GetArchiveSignature(Stream: TStream): TDGArchiveSignature;
begin
  Result := CARCHIVESIGNATURE_UNKNOWN;
  if Stream.Size >= szDGArchiveSignature then begin
    Stream.Position := 0;
    Stream.ReadBuffer(Result, szDGArchiveSignature);
  end; // if Stream.Size >= szDGArchiveSignature then begin
end; // function GetArchiveSignature(Stream: TStream): TDGArchiveSignature;

function GetArchiveSignature(const FileName: string): TDGArchiveSignature;
var
  ArchiveStream: TFileStream;
begin
  try
    ArchiveStream := TFileStream.Create(FileName, fmOpenRead or fmShareExclusive);
    Result := GetArchiveSignature(ArchiveStream);
  finally
    FreeAndNil(ArchiveStream);
  end; // try ... finally
end; // function GetArchiveSignature(const FileName: string): TDGArchiveSignature;

function GetArchiveTypeRec(Signature: TDGArchiveSignature): TDGArchiveTypeRec;
var
  Index: Integer;
begin
  Result := CARCHIVE_TYPES[CARCHIVESIGNATURE_UNKNOWN];
  for Index := Low(CARCHIVE_TYPES) to High(CARCHIVE_TYPES) do
    if CARCHIVE_TYPES[Index].Signature = Signature then begin
      Result := CARCHIVE_TYPES[Index];
      Exit;
    end; // if CARCHIVE_TYPES[Index].Signature = Signature then begin
end; // function GetArchiveTypeRec(Signature: TDGArchiveSignature): TDGArchiveTypeRec;

function GetArchiveType(const FileName: string): TDGArchiveType;
begin
  Result := GetArchiveTypeRec(GetArchiveSignature(FileName)).ArchiveType;
end; // function GetArchiveType(const FileName: string): TDGArchiveType;

function GetArchiveType(Strean: TStream): TDGArchiveType;
begin
  Result := GetArchiveTypeRec(GetArchiveSignature(Strean)).ArchiveType;
end; // function GetArchiveType(Strean: TStream): TDGArchiveType;

function GetArchiveName(const FileName: string): string;
begin
  Result := GetArchiveTypeRec(GetArchiveSignature(FileName)).Name;
end; // function GetArchiveName(const FileName: string): string;

function GetArchiveName(Stream: TStream): string;
begin
  Result := GetArchiveTypeRec(GetArchiveSignature(Stream)).Name;
end; // function GetArchiveName(Stream: TStream): string;

function GetArchiveTypeSignature(ArchiveType: TDGArchiveType): TDGArchiveSignature;
var
  Index: Integer;
begin
  Result := CARCHIVESIGNATURE_UNKNOWN;
  for Index := Low(CARCHIVE_TYPES) to High(CARCHIVE_TYPES) do
    if CARCHIVE_TYPES[Index].ArchiveType = ArchiveType then begin
      Result := CARCHIVE_TYPES[Index].Signature;
      Exit;
    end; // if CARCHIVE_TYPES[Index].ArchiveType = ArchiveType then begin
end; // function GetArchiveTypeSignature(ArchiveType: TDGArchiveType): TDGArchiveSignature;

end. // unit uDGArchiveType;
Usage:
add a button and a OpenDialog on the form, rename OpenDialog1 to OpenDialog, double-click the button and add this code:
  if OpenDialog.Execute then
    ShowMessage(GetArchiveName(OpenDialog.FileName));
The rest is up to you, have fun!
P.S. If you know any other archive signatures please let me know, I will update this unit and make it available to other people.

Monday, March 22, 2010

Indy or TClientSocket/TServerSocket?

Recently I had to develop a client-server application(in Delphi of course), nothing out of the ordinary, but as always, when I have this task, I'm frozed for a few minutes trying to answer the question "which components should I use? Indy or TClientSocket and TServerSocket?".
Maybe for some of you there's no problem choosing but for me it is, here is why:
- I work in Delphi 7, using Indy it's going to be a bumpy ride when upgrading to Delphi 2010(or Delphi 2011?), because Indy has changed a lot(the arhitecture).
- Indy is notifying itself using exceptions(client's hate exeptions/errors and so do we)
- TClient/ServerSocket: are very flexible, basically a wrapper for Windows socket methods found in WinSock.pas unit.
- TClient/ServerSocket: can be used in Blocking and Non-Blocking mode(read help for further information)
- TClient/ServerSocket: can easily cooperate with threads
- TClient/ServerSocket: stopping the server will NOT raise exceptions if there are clients connected, they simply get disconnected.
- TClient/ServerSocket: I can go on and on but I believe there are enough pro's for TClient/ServerSocket and enough downs for Indy that will make you do further investigations on this.

Let me know about your pro's and con's on this subject.
I am NOT saying that Indy is bad, it's just to lousy to use from my point of view, at least in Delphi 7 version.

P.S. for those of you who do not know, TClientSocket and TSererSocket do NOT appear in Internet tab on the component palette after installing Delphi 7, you must go to Components -> Install Packages... -> Add... -> browse to Delphi bin directory(default C:\Program Files\Borland\Delphi7\Bin -> type in file name "dclsockets70.bpl" and hit enter(return) key press OK and now you have successfully installed the TClient/ServerSocket components.

Friday, March 19, 2010

Check if remote port is opened

Here's something very simple with which you can check a port status(opened/closed) on remote host.
Add WinSock to uses clause
function ResolveAddress(HostName: String; out Address: DWORD): Boolean;
var  lpHost:        PHostEnt;
begin
  // Set default address
  Address := DWORD(INADDR_NONE);
  try
    // Check host name length
    if (Length(HostName) > 0) then begin
      // Try converting the hostname
      Address := inet_addr(PChar(HostName));
      // Check address
      if (DWORD(Address) = DWORD(INADDR_NONE)) then begin
        // Attempt to get host by name
        lpHost := gethostbyname(PChar(HostName));
        // Check host ent structure for valid ip address
        if Assigned(lpHost) and Assigned(lpHost^.h_addr_list^) then
          // Get the address from the list
          Address := u_long(PLongInt(lpHost^.h_addr_list^)^);
      end;// if (DWORD(Address) = DWORD(INADDR_NONE)) then begin
    end;// if (Length(HostName) > 0) then begin
  finally
    // Check result address
    if (DWORD(Address) = DWORD(INADDR_NONE)) then
      // Invalid host specified
      Result:= False
    else
      // Converted correctly
      Result := True;
  end;// try ... finally
end;// function ResolveAddress(HostName: String; out Address: DWORD): Boolean;

function IsPortOpened(const Host: string; Port: Integer): Boolean;
const
  szSockAddr = SizeOf(TSockAddr);
var
  WinSocketData: TWSAData;
  Socket: TSocket;
  Address: TSockAddr;
  dwAddress: DWORD;
label
  lClean;
begin
  // initialize result
  Result := False;
  // create WinSocketData
  if WinSock.WSAStartup(MakeWord(1, 1), WinSocketData) = 0 then begin
    // set address family
    Address.sin_family := AF_INET;
    // try to translate Host to IP address
    if NOT ResolveAddress(Host, dwAddress) then
      // faild! go to lClean label
      goto lClean;
    // set the address
    Address.sin_addr.S_addr := dwAddress;
    // create a socket
    Socket := WinSock.Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
    // if faild to create socket
    if Socket = INVALID_SOCKET then
      // go to lClean label
      goto lClean;
    // set the port
    Address.sin_port := WinSock.htons(Port);
    // attempt remote connection to Host on Port
    if WinSock.Connect(Socket, Address, szSockAddr) = 0 then begin
      // if succeded return true
      Result := True;
      // close the socket
      WinSock.closesocket(Socket);
    end;// if WinSock.Connect(Socket, Address, szSockAddr) = 0 then begin
  end;// if WinSock.WSAStartup(MakeWord(1, 1), WinSocketData) = 0 then begin
  // label to which we jump to clean up 
  lClean:
    WinSock.WSACleanup;
end;// function IsPortOpened(const Host: string; Port: Integer): Boolean;

Create a new VCL application, add a button on the main form, double-click the button and paste this code:
if IsPortOpened('google.com', 80) then
  ShowMessage('google has port 80 opened')
else
  ShowMessage('google has port 80 closed???');

Tuesday, March 9, 2010

How to get IP address

Here are two methods to get your IP address, add WinSock to uses clause.
function GetIPAddress: Integer;
var
  Buffer: array[0..255] of Char;
  RemoteHost: PHostEnt;
begin
  Winsock.GetHostName(@Buffer, 255);
  RemoteHost := Winsock.GetHostByName(Buffer);
  if RemoteHost = nil then
    Result := winsock.htonl($07000001) { 127.0.0.1 }
  else
    Result := longint(pointer(RemoteHost^.h_addr_list^)^);
    Result := Winsock.ntohl(Result);
end;// function GetIPAddress: Integer;

function GetIPAddressAsString: String;
var
  tempAddress: Integer;
  Buffer: array[0..3] of Byte absolute tempAddress;
begin
  tempAddress := GetIPAddress;
  Result := Format('%d.%d.%d.%d', [Buffer[3], Buffer[2], Buffer[1], Buffer[0]]);
end;// function GetIPAddressAsString: String;
Usage example:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetIPAddressAsString);
end;

Monday, March 8, 2010

Process list

Someone asked me a few days ago how to kill a process, well the job is pretty simple if you're familiar with Windows API, but what if NOT? and you still want to get a list of all processes running?
I've created a class which does just that and more! scroll to bottom of post to see how to use it.
{******************************************************************************}
{                                                                              }
{   Unit: uDGProcessList.pas                                                   }
{                                                                              }
{   Scope: Process manipulation                                                }
{                                                                              }
{   Info: it can get a list of all running processes, terminate them, etc.     }
{                                                                              }
{   Copyright© Dorin Duminica                                                  }
{                                                                              }
{******************************************************************************}
unit uDGProcessList;

interface

uses
  SysUtils,
  Windows,
  Classes,
  Graphics,
  TlHelp32,
  ShellApi,
  PsApi;

type
  // type used to store information about a process
  PDGProcessRec = ^TDGProcessRec;
  TDGProcessRec = record
    Name: AnsiString;
    ExeName: AnsiString;
    UserName: AnsiString;
    Domain: AnsiString;
    StartDateTime: TDateTime;
    MemoryUsage: DWORD;
    Usage: DWORD;
    ProcessID: DWORD;       // this process
    DefaultHeapID: DWORD;
    ModuleID: DWORD;        // associated exe
    ThreadCount: DWORD;
    ParentProcessID: DWORD; // this process's parent process
    PriClassBase: Longint;    // Base priority of process's threads
  end;// TDGProcessRec = record

type
  // type used to get user name and domain
  PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
    User: TSidAndAttributes;
  end;
  TOKEN_USER = _TOKEN_USER;

type
  TUnitType = (utByte, utKiloByte, utMegaByte, utGigaByte);

type
  TDGProcessList = class
  PRIVATE// variables and methods
    FList: TList;
    function GetProcessRec(INDEX: Integer): TDGProcessRec;
    function GetProcessFileName(dwProcessID: DWORD): AnsiString;
    function GetProcessUserAndDomain(dwProcessID: DWORD;
      var UserName, Domain: AnsiString): Boolean;
    function GetProcessStartDateTime(dwProcessID: DWORD): TDateTime;
    procedure SetProcessRec(INDEX: Integer; const Value: TDGProcessRec);
  PUBLIC// methods
    function Count: Integer;
    function TerminateProcess(dwProcessID: DWORD): Boolean; OVERLOAD;
    function TerminateProcess(const Name: AnsiString): Boolean; OVERLOAD;
    function Exists(dwProcessID: DWORD): Boolean; OVERLOAD;
    function Exists(dwProcessID: DWORD; var atIndex: Integer): Boolean; OVERLOAD;
    function Exists(const Name: AnsiString): Boolean; OVERLOAD;
    function Exists(const Name: AnsiString; var atIndex: Integer): Boolean; OVERLOAD;
    function ProcessInfoToStr(Index: Integer): AnsiString;
    function GetProcessIcon(Index: Integer;
      const bSmallIcon: Boolean = True): TIcon; OVERLOAD;
    function GetProcessIcon(const ExeName: AnsiString;
      const bSmallIcon: Boolean = True): TIcon; OVERLOAD;
    function GetProcessMemoryUsage(dwProcessID: DWORD;
      const UnitType: TUnitType = utByte): DWORD;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Refresh;
  PUBLIC// properties
    property Process[INDEX: Integer]: TDGProcessRec
      read GetProcessRec write SetProcessRec; DEFAULT;
  PUBLIC// constructor and destructor
    constructor Create;
    destructor Destroy; override;
  end;// TDGProcessList = class

implementation

{ TDGProcessList }

procedure TDGProcessList.Clear;
var
  Index: Integer;
begin
  for Index := FList.Count -1 downto 0 do
    Delete(Index);
end;// procedure TDGProcessList.Clear;

function TDGProcessList.Count: Integer;
begin
  Result := FList.Count;
end;// function TDGProcessList.Count: Integer;

constructor TDGProcessList.Create;
begin
  FList := TList.Create;
end;// constructor TDGProcessList.Create;

procedure TDGProcessList.Delete(Index: Integer);
var
  ProcessRec: PDGProcessRec;
begin
  ProcessRec := FList[Index];
  Dispose(ProcessRec);
  FList.Delete(Index);
end;// procedure TDGProcessList.Delete(Index: Integer);

destructor TDGProcessList.Destroy;
begin
  Clear;
  FreeAndNil(FList);
  inherited;
end;// destructor TDGProcessList.Destroy;

function TDGProcessList.Exists(dwProcessID: DWORD): Boolean;
var
  Index: Integer;
begin
  Result := Exists(dwProcessID, Index);
end;// function TDGProcessList.Exists(dwProcessID: DWORD): Boolean;

function TDGProcessList.Exists(dwProcessID: DWORD;
  var atIndex: Integer): Boolean;
var
  Index: Integer;
begin
  Result := True;
  for Index := 0 to FList.Count -1 do
    if Process[Index].ProcessID = dwProcessID then begin
      atIndex := Index;
      Exit;
    end;// if Process[Index].th32ProcessID = dwProcessID then begin
  Result := False;
end;// function TDGProcessList.Exists(dwProcessID: DWORD;

function TDGProcessList.Exists(const Name: AnsiString): Boolean;
var
  Index: Integer;
begin
  Result := Exists(Name, Index);
end;// function TDGProcessList.Exists(const Name: AnsiString): Boolean;

function TDGProcessList.Exists(const Name: AnsiString;
  var atIndex: Integer): Boolean;
var
  Index: Integer;
begin
  Result := True;
  for Index := 0 to FList.Count -1 do
    if SameText(Process[Index].Name, Name) then begin
      atIndex := Index;
      Exit;
    end;// if SameText(Process[Index].Name, Name) then begin
  Result := False;
end;// function TDGProcessList.Exists(const Name: AnsiString;

function TDGProcessList.GetProcessFileName(dwProcessID: DWORD): AnsiString;
var
  Handle: THandle;
begin
  Result := EmptyStr;
  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False,
    dwProcessID);
  try
    SetLength(Result, MAX_PATH);
    if Handle <> 0 then begin
      if GetModuleFileNameEx(Handle, 0, PAnsiChar(Result), MAX_PATH) > 0 then
        SetLength(Result, StrLen(PAnsiChar(Result)))
      else
        Result := EmptyStr;
    end else begin// if Handle <> 0 then begin
      if GetModuleBaseNameA(Handle, 0, PAnsiChar(Result), MAX_PATH) > 0 then
        SetLength(Result, StrLen(PAnsiChar(Result)))
      else
        Result := EmptyStr;
    end;// if Handle <> 0 then begin
  finally
    CloseHandle(Handle);
  end;// try
end;// function TDGProcessList.GetProcessFileName(dwProcessID: DWORD): AnsiString;

function TDGProcessList.GetProcessIcon(Index: Integer;
  const bSmallIcon: Boolean = True): TIcon;
begin
  Result := GetProcessIcon(Process[Index].ExeName);
end;// function TDGProcessList.GetProcessIcon(Index: Integer;

function TDGProcessList.GetProcessIcon(const ExeName: AnsiString;
  const bSmallIcon: Boolean = True): TIcon;
var
  FileInfo: _SHFILEINFOA;
  Flags: DWORD;
begin
  if bSmallIcon then
    Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX
  else
    Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SYSICONINDEX;
  Result := TIcon.Create;
  SHGetFileInfo(PAnsiChar(ExeName), 0, FileInfo, SizeOf(FileInfo), Flags);
  Result.Handle := FileInfo.hIcon;
end;// function TDGProcessList.GetProcessIcon(const ExeName: AnsiString;

function TDGProcessList.GetProcessMemoryUsage(dwProcessID: DWORD;
  const UnitType: TUnitType = utByte): DWORD;
const
  CFACTOR_BYTE = 1;
  CFACTOR_KILOBYTE = CFACTOR_BYTE * 1024;
  CFACTOR_MEGABYTE = CFACTOR_KILOBYTE * 1024;
  CFACTOR_GIGABYTE = CFACTOR_MEGABYTE * 1024;
var
  MemCounters: TProcessMemoryCounters;
  hProcess: THandle;
begin
  Result := 0;
  MemCounters.cb := SizeOf(TProcessMemoryCounters);
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);
  if hProcess <> 0 then begin
    if GetProcessMemoryInfo(hProcess, @MemCounters, SizeOf(MemCounters)) then
      case UnitType of
        utByte:
          Result := MemCounters.WorkingSetSize div CFACTOR_BYTE;
        utKiloByte:
          Result := MemCounters.WorkingSetSize div CFACTOR_KILOBYTE;
        utMegaByte:
          Result := MemCounters.WorkingSetSize div CFACTOR_MEGABYTE;
        utGigaByte:
          Result := MemCounters.WorkingSetSize div CFACTOR_GIGABYTE;
      end// case UnitType of
    else
      RaiseLastOSError;
    CloseHandle(hProcess)
  end;// if hProcess <> 0 then begin
end;// function TDGProcessList.GetProcessMemoryUsage(dwProcessID: DWORD;

function TDGProcessList.GetProcessRec(INDEX: Integer): TDGProcessRec;
begin
  if (INDEX <= -1) or (INDEX >= FList.Count) then
    raise Exception.Create('Index out of bounds');
  Result := PDGProcessRec(FList[INDEX])^;
end;// function TDGProcessList.GetProcessRec(INDEX: Integer): TDGProcessRec;

function TDGProcessList.GetProcessStartDateTime(
  dwProcessID: DWORD): TDateTime;

  function FileTimeToDateTime(ft: TFileTime): TDateTime;
  var
    ft1: TFileTime;
    st: TSystemTime;
  begin
    if ft.dwLowDateTime + ft.dwHighDateTime = 0 then
      Result := 0
    else
    begin
      FileTimeToLocalFileTime(ft, ft1);
      FileTimeToSystemTime(ft1, st);
      Result := SystemTimeToDateTime(st);
    end;
  end;
var
  ftCreationTime, lpExitTime, ftKernelTime, ftUserTime: TFileTime;
  hProcess: THandle;
begin
  Result := 0;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);
  if hProcess <> 0 then begin
    if GetProcessTimes(hProcess, ftCreationTime, lpExitTime,
        ftKernelTime, ftUserTime) then
      Result := FileTimeToDateTime(ftCreationTime)
    else
      RaiseLastOSError;
    CloseHandle(hProcess);
  end;// if hProcess <> 0 then begin
end;// function TDGProcessList.GetProcessStartDateTime(

function TDGProcessList.GetProcessUserAndDomain(dwProcessID: DWORD;
  var UserName, Domain: AnsiString): Boolean;
var
  hToken: THandle;
  cbBuf: Cardinal;
  tokUser: PTOKEN_USER;
  sidNameUse: SID_NAME_USE;
  hProcess: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwProcessID);
  if hProcess <> 0 then begin
    if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      tokUser := nil;
      while (not bSuccess) and
          (GetLastError = ERROR_INSUFFICIENT_BUFFER) do begin
        ReallocMem(tokUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, tokUser, cbBuf, cbBuf);
      end;// while (not bSuccess) and...
      CloseHandle(hToken);
      if not bSuccess then
        Exit;
      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, tokUser.User.Sid, nil, UserSize, nil, DomainSize, sidNameUse);
      if (UserSize <> 0) and (DomainSize <> 0) then begin
        SetLength(UserName, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, tokUser.User.Sid, PAnsiChar(UserName), UserSize,
            PAnsiChar(Domain), DomainSize, sidNameUse) then begin
          Result := True;
          UserName := StrPas(PAnsiChar(UserName));
          Domain := StrPas(PAnsiChar(Domain));
        end;// if LookupAccountSid(nil, tokUser.User.Sid, PAnsiChar(UserName), UserSize,
      end;// if (UserSize <> 0) and (DomainSize <> 0) then begin
      if bSuccess then
        FreeMem(tokUser);
    end;// if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then begin
    CloseHandle(hProcess);
  end;// if hProcess <> 0 then begin
end;// function TDGProcessList.GetProcessUserAndDomain(dwProcessID: DWORD;

function TDGProcessList.ProcessInfoToStr(Index: Integer): AnsiString;
const
  CCRLF = #$D#$A;
  CPROCESSREC_FMT = CCRLF +
    'Name = %s' + CCRLF +
    'ExeName = %s' + CCRLF +
    'User name = %s' + CCRLF +
    'Domain = %s' + CCRLF +
    'Started = %s' + CCRLF +
    'Memory usage = %d bytes' + CCRLF +
    'Usage = %d' + CCRLF +
    'Process ID = %d' + CCRLF +
    'Default heap ID = %d' + CCRLF +
    'Module ID = %d' + CCRLF +
    'Threads = %d' + CCRLF +
    'Parent process ID = %d' + CCRLF +
    'Priority base class = %d' + CCRLF;
var
  ProcessRec: TDGProcessRec;
begin
  ProcessRec := Process[Index];
  Result := Format(CPROCESSREC_FMT, [
    ProcessRec.Name,
    ProcessRec.ExeName,
    ProcessRec.UserName,
    ProcessRec.Domain,
    DateTimeToStr(ProcessRec.StartDateTime),
    ProcessRec.MemoryUsage,
    ProcessRec.Usage,
    ProcessRec.ProcessID,
    ProcessRec.DefaultHeapID,
    ProcessRec.ModuleID,
    ProcessRec.ThreadCount,
    ProcessRec.ParentProcessID,
    ProcessRec.PriClassBase]);
end;// function TDGProcessList.ProcessInfoToStr(Index: Integer): AnsiString;

procedure TDGProcessList.Refresh;
var
  ProcessEntry32: TProcessEntry32;
  ProcessRec: PDGProcessRec;
  hSnapshot: THandle;
  UserName: AnsiString;
  Domain: AnsiString;
begin
  Clear;
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  ProcessEntry32.dwSize := SizeOf(TProcessEntry32);
  if Process32First(hSnapshot, ProcessEntry32) then
    repeat
      New(ProcessRec);
      ProcessRec^.Name := StrPas(ProcessEntry32.szExeFile);
      ProcessRec^.ExeName := GetProcessFileName(ProcessEntry32.th32ProcessID);
      if GetProcessUserAndDomain(ProcessEntry32.th32ProcessID,
          UserName, Domain) then begin
        ProcessRec^.UserName := UserName;
        ProcessRec^.Domain := Domain;
      end;// if GetProcessUserAndDomain(ProcessEntry32.th32ProcessID,
      ProcessRec^.StartDateTime := GetProcessStartDateTime(
        ProcessEntry32.th32ProcessID);
      ProcessRec^.MemoryUsage := GetProcessMemoryUsage(
        ProcessEntry32.th32ProcessID);
      ProcessRec^.Usage := ProcessEntry32.cntUsage;
      ProcessRec^.ProcessID := ProcessEntry32.th32ProcessID;
      ProcessRec^.DefaultHeapID := ProcessEntry32.th32DefaultHeapID;
      ProcessRec^.ModuleID := ProcessEntry32.th32ModuleID;
      ProcessRec^.ThreadCount := ProcessEntry32.cntThreads;
      ProcessRec^.ParentProcessID := ProcessEntry32.th32ParentProcessID;
      ProcessRec^.PriClassBase := ProcessEntry32.pcPriClassBase;
      FList.Add(ProcessRec);
    until NOT Process32Next(hSnapshot, ProcessEntry32);
  if FList.Count > 0 then
    Delete(0);
  if hSnapshot <> 0 then
    CloseHandle(hSnapshot);
end;// procedure TDGProcessList.Refresh;

procedure TDGProcessList.SetProcessRec(INDEX: Integer;
  const Value: TDGProcessRec);
begin
  PDGProcessRec(FList[INDEX])^ := Value;
end;// procedure TDGProcessList.SetProcessRec(INDEX: Integer;

function TDGProcessList.TerminateProcess(dwProcessID: DWORD): Boolean;
var
  hProcess: THandle;
begin
  Result := False;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);
  if hProcess <> 0 then begin
    Result := Windows.TerminateProcess(hProcess, 0);
    CloseHandle(hProcess)
  end;// if hProcess <> 0 then begin
end;// function TDGProcessList.TerminateProcess(dwProcessID: DWORD): Boolean;

function TDGProcessList.TerminateProcess(const Name: AnsiString): Boolean;
var
  Index: Integer;
begin
  Result := False;
  for Index := 0 to FList.Count -1 do
    if SameText(Process[Index].Name, Name) then begin
      Result := TerminateProcess(Process[Index].ProcessID);
      Exit;
    end;// if SameText(Process[Index].Name, Name) then begin
end;// function TDGProcessList.TerminateProcess(const Name: AnsiString): Boolean;

end.// unit uDGProcessList;
How to fill a memo called Memo1 with all processes along with it's information
procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  ProcessList: TDGProcessList;
begin
  ProcessList := TDGProcessList.Create;
  ProcessList.Refresh;
  Memo1.Clear;
  for Index := 0 to ProcessList.Count -1 do
    Memo1.Text := Memo1.Text + ProcessList.ProcessInfoToStr(Index);
  FreeAndNil(ProcessList);
end;
How to terminate Notepad for instance
procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  ProcessList: TDGProcessList;
begin
  ProcessList := TDGProcessList.Create;
  ProcessList.Refresh;
  ProcessList.Exists('notepad.exe', Index);
  if (Index > 0) and (Index < ProcessList.Count) then
    ProcessList.TerminateProcess(ProcessList[Index].ProcessID);
  FreeAndNil(ProcessList);
end;

Tuesday, March 2, 2010

Delphigeist template has changed

As you can see, I've changed the template of delphigeist, reason? well the old one was loading so freaking slow that it would make you scream.
The new template is so simple and so fast that it should load in under 1 second.
I hope you like it, if not I'm sorry but it must be as fast as possible.

Monday, March 1, 2010

TurboHashedStringList updated

Updated TurboHashedStringList(thanks to SportsGuy) class with:
- indexof -> actually it calls IndexOfName
- added SaveToFile/Stream, LoadFromFile/Stream
- added Text property
Drop me a comment if you want some other things implemented
{******************************************************************************}
{                                                                              }
{   Unit: uHashedStringList.pas                                                }
{                                                                              }
{   Scope: TStringList replacement                                             }
{                                                                              }
{   Info: implements almost all methods of TStringList, easily extendable      }
{                                                                              }
{   Copyright© Dorin Duminica                                                  }
{                                                                              }
{******************************************************************************}
unit uHashedStringList;

interface

uses
  SysUtils,
  Classes;

type
  PStringHashRec = ^TStringHashRec;
  TStringHashRec = record
    Value: String;
    HashSensitive: Integer;
    HashInsensitive: Integer;
  end;// TStringHashRec = record

  PStringRec = ^TStringRec;
  TStringRec = record
    StringValue: PStringHashRec;
    Value: PStringHashRec;
    ObjectRef: TObject;
  end;// TStringEntry = record

type
  TurboHashedStringList = class
  private
    FList: TList;
    function GetValue(Name: String; bCaseSensitive: Boolean): String;
    procedure SetValue(Name: String; bCaseSensitive: Boolean;
      const Value: String);
    function GetItem(Index: Integer): PStringRec;
    function GetText(Index: Integer): String;
    procedure SetItem(Index: Integer; const Value: PStringRec);
    procedure SetText(Index: Integer; const Value: String);
    function GetTextStr: String;
    procedure SetTextStr(const Value: String);
  public
    constructor Create;
    destructor Destroy; OVERRIDE;
  public
    function Add(const s: String; const Value: String = ''): Integer; OVERLOAD;
    function Add(const s: String; AObject: TObject): Integer; OVERLOAD;
    function StringExists(const s: String): Boolean; OVERLOAD;
    function Append(const s: String; const Value: String = ''): Integer; OVERLOAD;
    function Append(const s: String; AObject: TObject): Integer; OVERLOAD;
    function StringExists(const s: String; var atIndex: Integer): Boolean; OVERLOAD;
    function Count: Integer;
    function IndexOf(const s: String): Integer; OVERLOAD;
    function IndexOf(const s: String; bCaseSensitive: Boolean): Integer; OVERLOAD;
    function IndexOfName(const s: String): Integer; OVERLOAD;
    function IndexOfName(const s: String; bCaseSensitive: Boolean): Integer; OVERLOAD;
    function IndexOfValue(const s: String): Integer; OVERLOAD;
    function IndexOfValue(const s: String; bCaseSensitive: Boolean): Integer; OVERLOAD;
    function StringExists(const s: String; var atIndex: Integer;
      const bCaseSensitive: Boolean): Boolean; OVERLOAD;
    function ValueExists(const s: String): Boolean; OVERLOAD;
    function ValueExists(const s: String; var atIndex: Integer): Boolean; OVERLOAD;
    function ValueExists(const s: String; var atIndex: Integer;
      const bCaseSensitive: Boolean): Boolean; OVERLOAD;
    procedure Clear;
    procedure Delete(Index: Integer; const bFreeObject: Boolean = False);
    procedure Exchange(Index1, Index2: Integer);
    procedure Insert(Index: Integer; const s: String; const Value: String = ''); OVERLOAD;
    procedure Insert(Index: Integer; const s: String; AObject: TObject); OVERLOAD;
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: String);
    procedure LoadFromFile(const FileName: String);
  public
    property Values[Name: String; bCaseSensitive: Boolean]: String
      read GetValue write SetValue;
    property Items[Index: Integer]: PStringRec
      read GetItem write SetItem;
    property Strings[Index: Integer]: String
      read GetText write SetText; DEFAULT;
    property Text: String
      read GetTextStr write SetTextStr;
  end;// TurboHashedStringList = class

implementation

uses Math;

function HashStringInsensitive(const Value: string): Integer;
var
  Index : Integer;
begin
  Result := 0;;
  for Index := 1 to Length(Value) do
    Result := ((Result shl 7) or (Result shr 25)) + Ord(UpCase(Value[Index]));
end;// function HashStringInsensitive(const Value: string): Integer;

function HashStringSensitive(const Value: string): Integer;
var
  Index : Integer;
begin
  Result := 0;;
  for Index := 1 to Length(Value) do
    Result := ((Result shl 7) or (Result shr 25)) + Ord(Value[Index]);
end;// function HashStringSensitive(const Value: string): Integer;

{ TurboHashedStringList }

function TurboHashedStringList.Add(const s, Value: String): Integer;
var
  StringData: PStringRec;
begin
  New(StringData);
  New(StringData.StringValue);
  New(StringData.Value);
  StringData.StringValue.Value := s;
  StringData.StringValue.HashSensitive := HashStringSensitive(s);
  StringData.StringValue.HashInsensitive := HashStringInsensitive(s);
  StringData.Value.Value := Value;
  StringData.Value.HashSensitive := HashStringSensitive(Value);
  StringData.Value.HashInsensitive := HashStringInsensitive(Value);
  Result := FList.Add(StringData)
end;// function TurboHashedStringList.Add(const s, Value: String): Integer;

function TurboHashedStringList.Add(const s: String;
  AObject: TObject): Integer;
begin
  Result := Add(s);
  PStringRec(FList[Result]).ObjectRef := AObject;
end;// function TurboHashedStringList.Add(const s: String;

function TurboHashedStringList.Append(const s, Value: String): Integer;
begin
  Result := Add(s, Value);
end;// function TurboHashedStringList.Append(const s, Value: String): Integer;

function TurboHashedStringList.Append(const s: String;
  AObject: TObject): Integer;
begin
  Result := Add(s, AObject);
end;// function TurboHashedStringList.Append(const s: String;

procedure TurboHashedStringList.Clear;
var
  Index: Integer;
  StringData: PStringRec;
begin
  for Index := FList.Count -1 downto 0 do
    Delete(Index);
end;// procedure TurboHashedStringList.Clear;

function TurboHashedStringList.Count: Integer;
begin
  Result := FList.Count;
end;// function TurboHashedStringList.Count: Integer;

constructor TurboHashedStringList.Create;
begin
  FList := TList.Create;
end;// constructor TurboHashedStringList.Create;

procedure TurboHashedStringList.Delete(Index: Integer;
  const bFreeObject: Boolean);
var
  StringData: PStringRec;
  Obj: TObject;
begin
  StringData := FList[Index];
  if bFreeObject then begin
    Obj := StringData.ObjectRef;
    FreeAndNil(Obj);
  end;// if bFreeObject then begin
  Dispose(StringData.StringValue);
  Dispose(StringData.Value);
  Dispose(StringData);
  FList.Delete(Index);
end;// procedure TurboHashedStringList.Delete(Index: Integer;

destructor TurboHashedStringList.Destroy;
begin
  Clear;
  FreeAndNil(FList);
end;// destructor TurboHashedStringList.Destroy;

procedure TurboHashedStringList.Exchange(Index1, Index2: Integer);
var
  Item1: PStringRec;
  Item2: PStringRec;
  TempI: PStringRec;
begin
  Item1 := FList[Index1];
  Item2 := FList[Index2];
  TempI := Item1;
  Item1 := Item2;
  Item2 := TempI;
end;// procedure TurboHashedStringList.Exchange(Index1, Index2: Integer);

function TurboHashedStringList.GetItem(Index: Integer): PStringRec;
begin
  Result := FList[Index];
end;// function TurboHashedStringList.GetItem(Index: Integer): PStringRec;

function TurboHashedStringList.GetText(Index: Integer): String;
begin
  Result := PStringRec(FList[Index]).StringValue.Value;
end;// function TurboHashedStringList.GetText(Index: Integer): String;

function TurboHashedStringList.GetValue(Name: String;
  bCaseSensitive: Boolean): String;
var
  Index: Integer;
begin
  Result := EmptyStr;
  if StringExists(Name, Index, bCaseSensitive) then
    Result := PStringRec(FList[Index]).Value.Value;
end;// function TurboHashedStringList.GetValue(Name: String;

procedure TurboHashedStringList.Insert(Index: Integer; const s, Value: String);
begin
  Add(s, Value);
  Exchange(Index, FList.Count -1);
end;// procedure TurboHashedStringList.Insert(Index: Integer; const s, Value: String);

function TurboHashedStringList.IndexOfName(const s: String): Integer;
begin
  Result := IndexOfName(s, False);
end;// function TurboHashedStringList.IndexOfName(const s: String): Integer;

function TurboHashedStringList.IndexOfName(const s: String;
  bCaseSensitive: Boolean): Integer;
begin
  StringExists(s, Result, bCaseSensitive);
end;// function TurboHashedStringList.IndexOfName(const s: String;

function TurboHashedStringList.IndexOfValue(const s: String): Integer;
begin
  Result := IndexOfValue(s, False);
end;// function TurboHashedStringList.IndexOfValue(const s: String): Integer;

function TurboHashedStringList.IndexOfValue(const s: String;
  bCaseSensitive: Boolean): Integer;
begin
  ValueExists(s, Result, bCaseSensitive);
end;// function TurboHashedStringList.IndexOfValue(const s: String;

procedure TurboHashedStringList.Insert(Index: Integer; const s: String;
  AObject: TObject);
begin
  Add(s, AObject);
  Exchange(Index, FList.Count -1);
end;// procedure TurboHashedStringList.Insert(Index: Integer; const s: String;

procedure TurboHashedStringList.SetItem(Index: Integer;
  const Value: PStringRec);
var
  StringData: PStringRec;
begin
  StringData := FList[Index];
  Dispose(StringData);
  FList[Index] := Value;
end;// procedure TurboHashedStringList.SetItem(Index: Integer;

procedure TurboHashedStringList.SetText(Index: Integer;
  const Value: String);
var
  StringData: PStringRec;
begin
  StringData := FList[Index];
  StringData.StringValue.Value := Value;
  StringData.StringValue.HashSensitive := HashStringSensitive(Value);
  StringData.StringValue.HashInsensitive := HashStringInsensitive(Value);
end;// procedure TurboHashedStringList.SetText(Index: Integer;

procedure TurboHashedStringList.SetValue(Name: String;
  bCaseSensitive: Boolean; const Value: String);
var
  Index: Integer;
  StringData: PStringRec;
begin
  if StringExists(Name, Index, bCaseSensitive) then begin
    StringData := FList[Index];
    StringData.Value.Value := Value;
    StringData.Value.HashSensitive := HashStringSensitive(Value);
    StringData.Value.HashInsensitive := HashStringInsensitive(Value); 
  end;// if StringExists(Name, Index, bCaseSensitive) then begin
end;// procedure TurboHashedStringList.SetValue(Name: String;

function TurboHashedStringList.StringExists(const s: String;
  var atIndex: Integer; const bCaseSensitive: Boolean): Boolean;
var
  Index: Integer;
  Hash: Integer;
begin
  Result := True;
  if bCaseSensitive then begin
    Hash := HashStringSensitive(s);
    for Index := 0 to FList.Count -1 do
      if PStringRec(FList[Index]).StringValue.HashSensitive = Hash then begin
        atIndex := Index;
        Exit;
      end;// if PStringRec(FList[Index]).StringValue.HashSensitive = Hash then begin
  end else begin
    Hash := HashStringInsensitive(s);
    for Index := 0 to FList.Count -1 do
      if PStringRec(FList[Index]).StringValue.HashInsensitive = Hash then begin
        atIndex := Index;
        Exit;
      end;// if PStringRec(FList[Index]).StringValue.HashInsensitive = Hash then begin
  end;// if bCaseSensitive then begin
  Result := False;
end;// function TurboHashedStringList.StringExists(const s: String;

function TurboHashedStringList.StringExists(const s: String): Boolean;
var
  Index: Integer;
begin
  Result := StringExists(s, Index);
end;// function TurboHashedStringList.StringExists(const s: String): Boolean;

function TurboHashedStringList.StringExists(const s: String;
  var atIndex: Integer): Boolean;
begin
  Result := StringExists(s, atIndex, False);
end;// function TurboHashedStringList.StringExists(const s: String;

function TurboHashedStringList.ValueExists(const s: String;
  var atIndex: Integer; const bCaseSensitive: Boolean): Boolean;
var
  Index: Integer;
  Hash: Integer;
begin
  Result := True;
  if bCaseSensitive then begin
    Hash := HashStringSensitive(s);
    for Index := 0 to FList.Count -1 do
      if PStringRec(FList[Index]).Value.HashSensitive = Hash then begin
        atIndex := Index;
        Exit;
      end;// if PStringRec(FList[Index]).Value.HashSensitive = Hash then begin
  end else begin
    Hash := HashStringInsensitive(s);
    for Index := 0 to FList.Count -1 do
      if PStringRec(FList[Index]).Value.HashInsensitive = Hash then begin
        atIndex := Index;
        Exit;
      end;// if PStringRec(FList[Index]).Value.HashInsensitive = Hash then begin
  end;// if bCaseSensitive then begin
  Result := False;
end;// function TurboHashedStringList.ValueExists(const s: String;

function TurboHashedStringList.ValueExists(const s: String;
  var atIndex: Integer): Boolean;
begin
  Result := ValueExists(s, atIndex, False);
end;// function TurboHashedStringList.ValueExists(const s: String;

function TurboHashedStringList.ValueExists(const s: String): Boolean;
var
  Index: Integer;
begin
  Result := ValueExists(s, Index);
end;// function TurboHashedStringList.ValueExists(const s: String): Boolean;

procedure TurboHashedStringList.LoadFromFile(const FileName: String);
var
  FileStream: TFileStream;
begin
  try
    FileStream := TFileStream.Create(FileName, fmOpenRead);
    LoadFromStream(FileStream);
  finally
    FreeAndNil(FileStream);
  end;// try
end;// procedure TurboHashedStringList.LoadFromFile(const FileName: String);

procedure TurboHashedStringList.LoadFromStream(Stream: TStream);
var
  Size: Integer;
  s: String;
begin
  Size := Stream.Size - Stream.Position;
  SetLength(s, Size);
  Stream.ReadBuffer(Pointer(s)^, Size);
  SetTextStr(s);
end;// procedure TurboHashedStringList.LoadFromStream(Stream: TStream);

procedure TurboHashedStringList.SaveToFile(const FileName: String);
var
  FileStream: TFileStream;
begin
  try
    FileStream := TFileStream.Create(FileName, fmCreate);
    SaveToStream(FileStream);
  finally
    FreeAndNil(FileStream);
  end;// try
end;// procedure TurboHashedStringList.SaveToFile(const FileName: String);

procedure TurboHashedStringList.SaveToStream(Stream: TStream);
var
  s: String;
begin
  s := GetTextStr;
  Stream.WriteBuffer(Pointer(s)^, Length(s));
end;// procedure TurboHashedStringList.SaveToStream(Stream: TStream);

function TurboHashedStringList.IndexOf(const s: String): Integer;
begin
  Result := IndexOf(s, False);
end;// function TurboHashedStringList.IndexOf(const s: String): Integer;

function TurboHashedStringList.IndexOf(const s: String;
  bCaseSensitive: Boolean): Integer;
begin
  Result := IndexOfName(s, bCaseSensitive);
end;// function TurboHashedStringList.IndexOf(const s: String;

function TurboHashedStringList.GetTextStr: String;
var
  Index: Integer;
begin
  Result := EmptyStr;
  for Index := 0 to FList.Count -1 do
    if PStringRec(FList[Index]).Value.HashInsensitive <> 0 then
      Result := Result + PStringRec(FList[Index]).StringValue.Value + '=' +
        PStringRec(FList[Index]).Value.Value + sLineBreak
    else
      Result := Result + PStringRec(FList[Index]).StringValue.Value + sLineBreak;
end;// function TurboHashedStringList.GetTextStr: String;

procedure TurboHashedStringList.SetTextStr(const Value: String);
var
  P, Start: PChar;
  s: String;
begin
  try
    Clear;
    P := Pointer(Value);
    if P <> NIL then
      while P^ <> #0 do begin
        Start := P;
        while NOT (P^ in [#0, #10, #13])
          do Inc(P);
        SetString(s, Start, P - Start);
        // if we have a line like Name=Value
        if Pos('=', s) > 0 then
          Add(
            // copy from 1st char to "="'s position -1
            Copy(s, 1, Pos('=', s) -1),
            // copy from "="'s position +1 till end of string
            Copy(s, Pos('=', s) +1, MaxInt))
        else
          Add(s);
        if P^ = #13 then
          Inc(P);
        if P^ = #10 then
          Inc(P);
      end;// while P^ <> #0 do begin
  except
  end;// try
end;// procedure TurboHashedStringList.SetTextStr(const Value: String);

end.// unit uHashedStringList;

Blogroll(General programming and Delphi feeds)