HHUtils 1.0 - A collection of useful delphi functions.

unit HHUtils;

interface

uses

  Windows, PsAPI, TlHelp32;

type

  TByteArray = array of Byte;

function GetPointerSize(lpBuffer: Pointer): Cardinal;

function PointerFromString(pData:Pointer):string;

function StringToPointer(sData:string):Pointer;

function xShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST;

function ReadFileToMem(sPath:string):Pointer;

function WriteFileFromPointer(pData:Pointer; sPath:string):boolean;

function ReadFileToString(sPath:string):AnsiString;

function WriteFileFromString(sData:string; sPath:string):boolean;

function ReadKeyToString(hRoot:HKEY; sKey:string; sSubKey:string):string;

function WriteKeyFromString(hRoot:HKEY; sKey:string; sSubKey:string; sData:string):boolean;

function UpdateFileResources(sPath: string; pData:Pointer; lpType:PChar; lpName:PChar; bDelete:boolean):boolean;

function GetFileResource(hMod:THandle; lpType:PChar; lpName:PChar):Pointer;

function ReadFileToByteArray(sPath:string):TByteArray;

function WriteFileFromByteArray(bData:TByteArray; sPath:string):boolean;

function FileExists(sPath:string):boolean;

function GetAPIHandle(sLib:string; sProc:string):DWORD;

function KillProcessByName(sName:string):boolean;

function GetProcessPath(PID:DWORD):string;

function GetProcessPriority(dwPID:DWORD):string;

function SetProcessPriority(dwPID:DWORD; pClass:Cardinal):boolean;

function GetWindowState(sText:string):string;

function SetWindowState(sText:string; State:Cardinal):LongBool;

function GetWindowsVersion():string;

function UserName():string;

function GetCountry():string;

function PCName():string;

function StrReverse(sInput:string):string;

function LeftStr(sInput:string; Position:integer):string;

function RightStr(sInput:string; Position:integer):string;

function MidStr(sInput:string; iStart:integer; iEnd:integer):string;

implementation

function GetPointerSize(lpBuffer: Pointer): Cardinal; // Function by ErazerZ

begin

  if lpBuffer = nil then

    Result := Cardinal(-1)

  else

    Result := Cardinal(Pointer(Cardinal(lpBuffer) -4)^) and $7FFFFFFC -4;

end;

function PointerFromString(pData:Pointer):string;

begin

  SetLength(Result, GetPointerSize(pData));

  Move(pData^, Result[1], GetPointerSize(pData));

end;

function StringToPointer(sData:string):Pointer;

begin

  GetMem(Result, Length(sData));

  Move(sData[1], Result^, Length(sData));

end;

function xShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST;

var

hProc:    DWORD;

begin

  GetProcAddress(LoadLibrary(PChar('shell32')), PChar('ShellExecuteA'));

  asm

    mov hProc, eax

    push ShowCmd

    push Directory

    push Parameters

    push FileName

    push Operation

    push hWnd

    call hProc

  end;

end;

function ReadFileToMem(sPath:string):Pointer;

var

hFile:    THandle;

pBuffer:  Pointer;

dSize:    DWORD;

dRead:    DWORD;

begin

hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);

if hFile <> 0 then

    dSize := GetFileSize(hFile, nil);

    if dSize <> 0 then

    begin

      SetFilePointer(hFile, 0, nil, FILE_BEGIN);

      GetMem(Result, dSize);

      ReadFile(hFile, Result^, dSize, dRead, nil);

      if dRead = 0 then

        MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)

     end;

    CloseHandle(hFile);

end;

function WriteFileFromPointer(pData:Pointer; sPath:string):boolean;

var

hFile:    THandle;

dWritten: DWORD;

dSize:    DWORD;

begin

  hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);

  if hFile <> 0 then

  begin

    SetFilePointer(hFile, 0, nil, FILE_BEGIN);

    dSize := GetPointerSize(pData);

    WriteFile(hFile, pData^, dSize, dWritten, nil);

    if dWritten = 0 then

      Result := FALSE

        else

      Result := TRUE;

  end;

  FreeMem(pData, dSize);

  CloseHandle(hFile);

end;

function ReadFileToString(sPath:string):AnsiString;

var

hFile:    THandle;

sBuffer:  AnsiString;

dSize:    DWORD;

dRead:    DWORD;

begin

hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);

if hFile <> 0 then

    dSize := GetFileSize(hFile, nil);

    if dSize <> 0 then

      begin

        SetFilePointer(hFile, 0, nil, FILE_BEGIN);

        SetLength(sBuffer, dSize);

        ReadFile(hFile, sBuffer[1], dSize, dRead, nil);

        if dRead = 0 then

          MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)

            else

          Result := sBuffer;

      end;

    CloseHandle(hFile);

end;

function WriteFileFromString(sData:string; sPath:string):boolean;

var

hFile:    THandle;

dWritten: DWORD;

begin

hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

if hFile <> 0 then

  begin

    SetFilePointer(hFile, 0, nil, FILE_BEGIN);

    WriteFile(hFile, sData[1], Length(sData), dWritten, nil);

    if dWritten = 0 then

      Result := FALSE

        else

      Result := TRUE;

  end;

  CloseHandle(hFile);

end;

// Example: ReadKeyToString(HKEY_LOCAL_MACHINE, 'SOFTWARE\HHC', 'Username')

function ReadKeyToString(hRoot:HKEY; sKey:string; sSubKey:string):string;

var

hOpen:    HKEY;

sBuff:    array[0..255] of char;

dSize:    integer;

begin

  if (RegOpenKeyEx(hRoot, PChar(sKey), 0, KEY_QUERY_VALUE, hOpen) = ERROR_SUCCESS) then

  begin

    dSize := SizeOf(sBuff);

    RegQueryValueEx(hOpen, PChar(sSubKey), nil, nil, @sBuff, @dSize);

    Result := sBuff

  end;

  RegCloseKey(hOpen);

end;

// Example: WriteKeyFromString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Example123', 'UserID', '#1')

function WriteKeyFromString(hRoot:HKEY; sKey:string; sSubKey:string; sData:string):boolean;

var

hOpen:    HKEY;

hResult:  HKEY;

begin

  if (RegOpenKeyEx(hRoot, nil, 0, KEY_ALL_ACCESS, hOpen) = ERROR_SUCCESS) then

  begin

    RegCreateKeyEx(hOpen, PChar(sKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hResult, nil);

    if (RegSetValueEx(hResult, PChar(sSubKey), 0, REG_SZ, PChar(sData), Length(sData)) = ERROR_SUCCESS) then

      Result := TRUE

        else

      Result := FALSE;

  end;

  RegCloseKey(hOpen);

end;

// Example: UpdateFileResources('C:\test.exe', ReadFileToMem('C:\new.exe'), RT_RCDATA, '123', FALSE);

function UpdateFileResources(sPath: string; pData:Pointer; lpType:PChar; lpName:PChar; bDelete:boolean):boolean;

var

hRes:   THandle;

begin

  hRes := BeginUpdateResource(PChar(sPath), bDelete);

  if hRes <> 0 then

  begin

    UpdateResource(hRes, lpType, lpName, 1033, pData, GetPointerSize(pData));

    EndUpdateResource(hRes, FALSE);

    Result := TRUE;

  end

  else

    Result := FALSE;

end;

// Example: GetFileResource(GetModuleHandle(nil), RT_RCDATA, 'HH1')

function GetFileResource(hMod:THandle; lpType:PChar; lpName:PChar):Pointer;

var

hRes, hLoad:  THandle;

dSize:        DWORD;

begin

  hRes := FindResource(hMod, lpName, lpType);

  if hRes <> 0 then

    dSize := SizeofResource(hMod, hRes);

    if dSize <> 0 then

    begin

      hLoad := LoadResource(hMod, hRes);

      Result := LockResource(hLoad);

    end;

end;

function ReadFileToByteArray(sPath:string):TByteArray;

var

hFile:    THandle;

dSize:    DWORD;

dRead:    DWORD;

bBuff:    array of Byte;

i:        integer;

begin

  hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);

  if hFile <> 0 then

    dSize := GetFileSize(hFile, nil);

    if dSize <> 0 then

      begin

        SetFilePointer(hFile, 0, nil, FILE_BEGIN);

        SetLength(bBuff, dSize);

        ReadFile(hFile, bBuff[1], dSize, dRead, nil);

        if dRead = 0 then

          MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)

          else

          begin

            SetLength(Result, dSize);

            for i := 0 to dSize do

              Result[i] := bBuff[i + 1];

            end;

      end;

end;

// Example: WriteFileFromByteArray(ReadFileToByteArray('C:\test.exe'), 'C:\bytearray.exe')

function WriteFileFromByteArray(bData:TByteArray; sPath:string):boolean;

var

hFile:    THandle;

dWritten: DWORD;

begin

hFile := CreateFile(PChar(sPath), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

if hFile <> 0 then

  begin

    SetFilePointer(hFile, 0, nil, FILE_BEGIN);

    WriteFile(hFile, bData[0],Length(bData), dWritten, nil);

    if dWritten = 0 then

      Result := FALSE

        else

      Result := TRUE;

  end;

  CloseHandle(hFile);

end;

function FileExists(sPath:string):boolean;

var

hFile:    THandle;

FDATA:    TWin32FindData;

begin

  hFile := FindFirstFile(PChar(sPath), FDATA);

  if hFile = INVALID_HANDLE_VALUE then

    Result := FALSE

      else

    Result := TRUE;

  CloseHandle(hFile);

end;

{ GetAPIHandle Example:

 var

xShellExecute:  DWORD;

sFile:          PChar;

begin

xShellExecute := GetAPIHandle('shell32', 'ShellExecuteA');

sFile := 'C:\test.exe';

asm

  push 1

  push 0

  push 0

  push sFile

  push 0

  push 0

  call xShellExecute

end; }

function GetAPIHandle(sLib:string; sProc:string):DWORD;

var

hProc:    DWORD;

begin

  GetProcAddress(LoadLibrary(PChar(sLib)), PChar(sProc));

    asm

      mov hProc, eax

    end;

  if hProc <> 0 then

  Result := hProc;

end;

function KillProcessByName(sName:string):boolean;

var

hOpen, hSnap:   THandle;

PROC:           TPROCESSENTRY32;

hProc:          LongBool;

begin

  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  if hSnap <> 0 then

    PROC.dwSize := SizeOf(PROC);

    if (Process32First(hSnap, PROC)) then

    begin

      while hProc <> FALSE do

      begin

        if sName = PROC.szExeFile then

        begin

          hOpen := OpenProcess(PROCESS_TERMINATE, FALSE, PROC.th32ProcessID);

          if (TerminateProcess(hOpen, 0)) then

            Result := TRUE

              else

            Result := FALSE;

          CloseHandle(hOpen);

        end;

        hProc := Process32Next(hSnap, PROC);

      end;

    end;

end;

function GetProcessPath(PID:DWORD):string;

var

hOpen:    THandle;

sBuff:    array[0..255] of char;

begin

  hOpen := OpenProcess(PROCESS_VM_READ or PROCESS_QUERY_INFORMATION, FALSE, PID);

  if hOpen <> 0 then

  begin

    GetModuleFileNameEx(hOpen, 0, sBuff, SizeOf(sBuff));

    Result := sBuff;

  end;

  CloseHandle(hOpen);

end;

function GetProcessPriority(dwPID:DWORD):string;

var

hOpen:    THandle;

lClass:   Cardinal;

begin

  hOpen  := OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, FALSE, dwPID);

  if hOpen <> 0 then

  begin

    lClass := GetPriorityClass(hOpen);

    if lClass = NORMAL_PRIORITY_CLASS then

      Result := 'Normal'

    else if lClass = IDLE_PRIORITY_CLASS then

      Result := 'Idle'

    else if lClass = HIGH_PRIORITY_CLASS then

      Result := 'High'

    else if lClass = REALTIME_PRIORITY_CLASS then

      Result := 'Real Time'

    else

      Result := '-';

  end;

  CloseHandle(hOpen);

end;

// Example: SetProcessPriority(10120, NORMAL_PRIORITY_CLASS);

function SetProcessPriority(dwPID:DWORD; pClass:Cardinal):boolean;

var

hOpen:    THandle;

begin

  hOpen := OpenProcess(PROCESS_SET_INFORMATION, FALSE, dwPID);

  if hOpen <> 0 then

    if SetPriorityClass(hOpen, pClass) then

      Result := TRUE

        else

      Result := FALSE;

  CloseHandle(hOpen);

end;

function GetWindowState(sText:string):string;

var

PLACE:        TWindowPlacement;

hWindow:      HWND;

begin

  hWindow := FindWindow(nil, PChar(sText));

  if hWindow <> 0 then

  begin

    PLACE.length := SizeOf(PLACE);

    GetWindowPlacement(hWindow, @PLACE);

    if PLACE.showCmd = SW_SHOWMAXIMIZED then

      Result := 'Maximized'

    else if PLACE.showCmd = SW_SHOWNORMAL then

      Result := 'Normal'

    else if PLACE.showCmd = SW_SHOWMINIMIZED then

      Result := 'Minimized';

  end;

  CloseHandle(hWindow);

end;

// Example: SetWindowState('Notepad'), SW_SHOW);

function SetWindowState(sText:string; State:Cardinal):LongBool;

var

hWindow:  HWND;

SETPLACE: TWindowPlacement;

begin

  hWindow := FindWindow(nil, PChar(sText));

  if hWindow <> 0 then

  begin

    SETPLACE.length  := SizeOf(SETPLACE);

    SETPLACE.showCmd := State;

    if (SetWindowPlacement(hWindow, @SETPLACE)) then

      Result := TRUE

        else

      Result := FALSE;

  end;

  CloseHandle(hWindow);

end;

function GetWindowsVersion():string;

var

OSINFO:   TOSVERSIONINFO;

begin

  OSINFO.dwOSVersionInfoSize := SizeOf(OSINFO);

  GetVersionEx(OSINFO);

  if OSINFO.dwMajorVersion = 3 then

    Result := 'Windows 3.11'

  else if OSINFO.dwMajorVersion = 4 then

    Result := 'Windows 2000'

  else if OSINFO.dwMajorVersion = 5 then

    Result := 'Windows XP'

  else if OSINFO.dwMajorVersion = 6 then

    Result := 'Windows Vista'

end;

function UserName():string;

var

sBuff:    array[0..256] of char;

dSize:    Cardinal;

begin

  dSize := 256;

  GetUserName(sBuff, dSize);

  Result := sBuff;

end;

function GetCountry():string;

var

sBuff:    array[0..256] of char;

dSize:    integer;

begin

  GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_SENGCOUNTRY, sBuff, 256);

  Result := sBuff;

end;

function PCName():string;

var

sBuff:    array[0..256] of char;

dSize:    Cardinal;

begin

  dSize := 256;

  GetComputerName(sBuff, dSize);

  Result := sBuff;

end;

function StrReverse(sInput:string):string;

var

Count:    integer;

begin

  For Count := 0 to Length(sInput) do

  begin

    Result := Result + sInput[Length(sInput) - Count]

  end;

end;

function LeftStr(sInput:string; Position:integer):string;

var

Count:  integer;

begin

  For Count := 1 to Position do

  begin

    Result := Result + sInput[Count];

  end;

end;

function RightStr(sInput:string; Position:integer):string;

var

Count:  integer;

begin

  For Count := Length(sInput) - Position + 1 to Length(sInput) do

  begin

    Result := Result + sInput[Count];

  end;

end;

function MidStr(sInput:string; iStart:integer; iEnd:integer):string;

var

Count:  integer;

begin

  For Count := iStart to iEnd do

  begin

    Result := Result + sInput[Count]

  end;

end;

end.