Четверг, 28.03.2024, 22:03 Приветствую вас Гость | Группа "Гости" 
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Модератор форума: Anton93  
delphicode » Delphi » Процедуры и функции Delphi » Несколько полезных функций. (WinAPI)
Несколько полезных функций.
Волк-1024Дата: Среда, 28.12.2011, 20:48 | Сообщение # 1
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 469
Статус: Offline
Вот решил выложить некоторые из самописных функций. Все написаны с использованием только API. Может кому и пригодится...

1. GetCurrentFileName(): string

Функция для получения текущего имени файла. Аналог ParamStr(0); Только короче.

Code

function GetCurrentFileName(): string;
var
             FBuff: array[0..255] of char;
begin
             GetModuleFileName(0, FBuff, (SizeOf(FBuff)));
             Result:=(FBuff);
end;


2. GetCurrentFileParam(): PChar

Функция для получения текущих параметров запуска. Аналог ParamStr(1). Все действия прокомментированы.

Code
           
function GetCurrentFileParam(): PChar; assembler;
asm

              mov eax, 0h                  {Обнуляем eax}
              call GetCommandLine        {Получаем текущие параметры запуска}
              mov edi, eax                  {Результат работы записываем в edi}
              mov al, 20h                    {В al помещаем код пробела}
              mov ecx, -1
              repne scasb                    {Ищем пробел}
              cmp byte ptr [edi], bl      {Проверяем наличе его}
              jne @_OK                       {Если нашли, прыгаем на метку @_OK}
              jmp @@_E                     {Если не нашли, прыгаем на выход}

@_OK:

              repe scasb
              dec edi                          {Удаляем пробел}

              mov result, edi              {Записываем результат функции}
              xor edi, edi                   {Обнуляем edi}

@@_E:

              nop                      {Ничего не делаем. Выходим из функции}

end;


3. GetFilePointer(hFile: Cardinal): integer;

Функция для получения текущей позиции в файле. Аналог какой-то большой компонентной функции.

Code

function GetFilePointer(hFile: Cardinal): integer;
begin
             Result:=SetFilePointer(hFile, 0, nil, FILE_CURRENT);
end;


4. FileEx(FileName: string): Boolean;

Функция для проверки наличия файла. Аналог FileExists.

Code

function FileEx(FileName: string): Boolean;
var
             H: DWORD;
             FD: TWin32FindData;
begin
             H:=FindFirstFile(PChar(FileName), FD);
             if H<>INVALID_HANDLE_VALUE then
                Result:=true
             else
                Result:=false;
end;


5. StrToHex(Str: string): string;

Функция конвертирует сроку в HEX значения.

Code

function StrToHex(Str: string): string;
var
             i, ls: integer;
             s: string;
begin
             ls:=(Length(Str));
             for i:=1 to (ls) do
                s:=s+(inttohex(ord(Str[i]), 2));
             Result:=s
end;


6. ExtractByte(FName: string; fbegin, fend, byteread: integer; Exfile: string): integer;

Функция извлекает опеределённое количество байтов из файла и записывает куда-нибудь. После её написания очень часто её использовал для извлечения полезноя нагрузки из файла носителя. Например dll библиотеку с функциями перехвата API и т.д. Полезная вобщем...

Code

function ExtractByte(FName: string; fbegin, fend, byteread: integer; Exfile:
             string): integer;
var
             F1, F2: DWORD;
             ofs: _OfStruct;
             RD, WR: Cardinal;
             FBuff: array[1..1024] of byte;
begin
             F2:=0;
             Result:=0;
             F1:=OpenFile(PChar(FName), OFS, 0);
             if F1<>INVALID_HANDLE_VALUE then
             begin
                F2:=CreateFile(PChar(Exfile), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
                   OPEN_ALWAYS, 0, 0);
                if F2<>INVALID_HANDLE_VALUE then
                begin
                   SetFilePointer(F1, fbegin, nil, 0);
                   repeat
                      ReadFile(F1, FBuff, byteread, RD, nil);
                      WriteFile(F2, FBuff, RD, WR, nil);
                   until (RD=0)or(GetFilePointer(F1)>=fend);
                end;
             end;
              CloseHandle(F1);
              CloseHandle(F2);
end;


Пример использования: ExtractByte('1.exe', $0002F530, $005C9FF, 1024, '2.exe'); 1-й параметр это файл из которого нужно извлекать. 2-й парам. это адрес начало считавания. 0 - для начала файла. 3-й адрес конца считавания. 4-й по скольку байт считывать из файла. 5-й куда записать. В итоге функция скопирует все что находится между $0002F530 и $005C9FF адресом.

7. GetRegValue(RKey: HKey; Key, N: PChar; var Res: string): integer;

Функция для получения значение ключа реестра. Аналог функции из компонента Registry.

Code

function GetRegValue(RKey: HKey; Key, N: PChar; var Res: string): integer;
var
             HK: HKey;
             DT, DS: DWORD;
begin
             Result:=0;
             if RegOpenKeyEx(RKey, Key, 0, $0001, HK)<>0 then exit;
             if (RegQueryValueEx(HK, N, nil, @DT, nil, @DS)<>0)or(DT<>1) then
             begin
                RegCloseKey(HK);
                Exit;
             end;
             SetString(RES, nil, (DS-1));
             RegQueryValueEx(HK, N, nil, @DT, (PByte(@RES[1])), @DS);
             RegCloseKey(HK);
             Result:=(length(RES));
end;


8. RegAdd(Root: HKEY; KeyPath: PChar; Key_Type: cardinal; KeyName, Value: PChar): boolean;

Функция для добавления кл. реестра. Аналог функция из кмп. Registry

Code

function RegAdd(Root: HKEY; KeyPath: PChar; Key_Type: cardinal; KeyName, Value: PChar): boolean;
var
             Key: HKEY;
begin
             RegAdd:=false;
             if RegOpenKeyEx(Root, KeyPath, 0, $0004 or $0002, Key)=0 then
             begin
                if RegSetValueEx(Key, KeyName, 0, Key_Type, Value,
                lstrlen(PChar(Value))+Length(Value))>0 then
                result:=true;
                RegCloseKey(Key);
             end;
end;


Пример использования: RegAdd(HKEY_LOCAL_MACHINE, 'Путь до ключа', REG_SZ, 'Имя ключа', 'Его значение') вернёт true если всё хорошо.

9. Patch_Byte(FN: string; B: array of integer; T: array of char);

Кривая функция для патчинга файлов.

Code

procedure Patch_Byte(FN: string; B: array of integer; T: array of char);
var
             c: byte;
             F: THandle;
             i, bl: integer;
             BytesRead: DWORD;
begin
             i:=0;
             BL:=(Length(T));
             F:=(FileOpen(FN, $0002));
             repeat
                c:=(ord(char(pchar(T[i]))));
                SetFilePointer(F, B[i], nil, 0);
                WriteFile(F, c, (SizeOf(c)), BytesRead, nil);
                i:=i+1;
             until (i>=(bl));
             FileClose(F);


Пример: Patch_Byte('Имя файла', Массив из адресов для патча, Массив из значений);

10. InjectDLL(DllPath: string; ProcID: Cardinal): boolean;

Функция для ижекта dll библиотек в процесс.

Code

function InjectDLL(DllPath: string; ProcID: Cardinal): boolean;
var
             L, R: Pointer;
             P, LN, TID, TH: Cardinal;
begin
             Result:=False;
             P:=OpenProcess(($000F0000 or $00100000 or $FFF), False, ProcID);
             if P<>0 then
             begin
                L:=GetProcAddress(GetModuleHandle('kernel32.dll'), ('LoadLibraryA'));
                if L<>nil then
                begin
                   R:=VirtualAllocEx(P, nil, (Length(DllPath)), $1000, 4);
                   if R<>nil then
                   begin
                      if WriteProcessMemory(P, R, (@DllPath[1]), (Length(DllPath)), LN)
                         then
                      begin
                         TH:=CreateRemoteThread(P, nil, 0, L, R, 0, Tid);
                         if TH>0 then
                         begin
                            WaitForSingleObject(TH, (DWORD($FFFFFFFF)));
                            VirtualFreeEx(P, R, 0, $8000);
                            CloseHandle(P);
                            Result:=True;
                         end;
                      end;
                   end;
                end;
             end;
end;


11. GetValFromWrd(W: string; var Wrd_B: array of string);

Функция разделит слово по буквам и загрузит в массив. (Вроде. =) )

Code

procedure GetValFromWrd(W: string; var Wrd_B: array of string);
var
             i, lw: integer;
begin
             lw:=(Length(W));
             for i:=0 to ((lw)-1) do
             Wrd_B[i]:=(Copy(W, i+1, 1));
end;


12. UsbEx(const Dir: string): Boolean;

Функция для проверки наличия диска или флешки.

Code

function Usbex(const Dir: string): Boolean;
var
             Code: Integer;
begin
             Code:=GetFileAttributes(PChar(Dir));
             Result:=(Code<>-1)and(FILE_ATTRIBUTE_DIRECTORY and Code<>0);
end;


13. Несколько не API функций для работы со строками.

ReadStr - Прочтет указанный номер сроки в файле.
ChekStr - Покажет сколько строк в файле.
LoadStr - Загрузит все строки из файла в массив.

Code

function ReadStr(tfile: string; num: integer): string;
var
             t: textfile;
             a: array[0..32] of string;
             i: integer;
begin
             AssignFile(t, tfile);
             reset(t);
             for i:=0 to num do
             begin
                readln(t, a[num]);
             end;
             result:=a[num];
             closefile(t);
end;

function ChekStr(path: string): integer;
var
             f: textfile;
             i: integer;
             b: array[0..0] of string;
begin
             i:=0;
             result:=(i);
             AssignFile(f, path);
             Reset(f);
             while not SeekEof(f) do
             begin
                ReadLn(f, b[0]);
                inc(i);
                result:=(i);
             end;
             CloseFile(f);
end;

procedure LoadStr(tf: string; var txb: array of string);
var
             t: textfile;
             i, i2: integer;
             tx: array of string;
begin
             i2:=ChekStr(tf);
             Setlength(tx, (i2+1));
             AssignFile(t, tf);
             reset(t);
             for i:=0 to i2 do
             begin
                readln(t, tx[i]);
             end;
             closefile(t);
             for i:=0 to i2 do
             begin
                txb[i]:=tx[i];
                if (txb[i]=(''))or(tx[i]=('')) then
                break;
             end;
end;


14. GetFuncAvailable(LibN, FuncN: string): integer;

Проверит наличие функции в библиотеке.

Code

function GetFuncAvailable(LibN, FuncN: string): integer;
var
             LH: THandle;
             FA: Pointer;
begin
             Result:=0;
             if LoadLibrary(PChar(LibN))=0 then exit;
             LH:=(GetModuleHandle(PChar(LibN)));
             if LH<>0 then
             begin
                FA:=(GetProcAddress(LH, PChar(FuncN)));
                if FA<>nil then
                Result:=(integer(FA));
             end;
end;


15. CreateSvc(ExPath: PChar): boolean

Функция создаёт сервис.

Code

function CreateSvc(ExPath: PChar): boolean;
var
        Svc, SCMgr: integer;
begin
        Result:=False;
        SCMgr:=OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
        if (SCMgr<>0) then
        begin
           Svc:=CreateService(SCMgr, (PChar(D(svcn))), (PChar(D(svcn))),
           STANDARD_RIGHTS_REQUIRED, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,
           SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
           ExPath, nil, nil, nil, nil, nil);
           CloseServiceHandle(SCMgr);
           if (svc<>0) then
              Result:=true
           else
           Result:=false;
        end;
        CreateSvc:=Result;
end;


16. DeleteSvc(SvcName: PChar): integer;

Удаляет сервис по имени.

Code

function DeleteSvc(SvcName: PChar): integer;
var
       Svc, SCMgr: cardinal;
begin
        Result:=0;
        SCMgr:=OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
        if SCMgr=0 then
        Result:=-1;
        Svc:=OpenService(SCMgr, SvcName, SERVICE_ALL_ACCESS);
        if Svc=0 then
           Result:=Result-1;
        if not DeleteService(Svc) then
           Result:=Result-1;
        CloseServiceHandle(Svc);
end;


Фуух устал. Потом еще добавлю.


Pascal, C\C++, Assembler, Python

Сообщение отредактировал Волк-1024 - Четверг, 29.12.2011, 13:37
 
Волк-1024Дата: Среда, 28.12.2011, 20:50 | Сообщение # 2
Авторитетный
Зарегистрирован: 24.07.2011
Группа: Модераторы
Сообщений: 469
Статус: Offline
Блин. Сколько ошибок...

Pascal, C\C++, Assembler, Python
 
delphicode » Delphi » Процедуры и функции Delphi » Несколько полезных функций. (WinAPI)
  • Страница 1 из 1
  • 1
Поиск:

delphicode.ru © 2008 - 2024 Хостинг от uCoz