HHUtils 1.0 - A collection of useful delphi functions.

posted 11 Mar 2010, 16:06 by Delphi Basics   [ updated 13 Mar 2010, 16:32 ]
{
    
Unit : HHUtils
    Coder: steve10120
    Website: hackhound.org
    Compiled: Delphi 7
}
 
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.
Comments