WinAPI函数库

原创 2006年05月25日 14:53:00

{=========================================================================
   功  能: WinAPI函数库
   时  间: SilverLong 2005/10/09
   版  本: 1.0
   备  注:
=========================================================================}
unit WinAPI;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Mask, ImgList, ToolWin ,winsock,
  ComObj,WinInet,Registry, Buttons, Menus,ShellApi, Grids,TlHelp32;

const
        SystemBasicInformation = 0;
        SystemPerformanceInformation = 2;
        SystemTimeInformation = 3;
 
type
        TPDWord = ^DWORD;

        TSystem_Basic_Information = packed record
                dwUnknown1: DWORD;
                uKeMaximumIncrement: ULONG;
                uPageSize: ULONG;
                uMmNumberOfPhysicalPages: ULONG;
                uMmLowestPhysicalPage: ULONG;
                uMmHighestPhysicalPage: ULONG;
                uAllocationGranularity: ULONG;
                pLowestUserAddress: Pointer;
                pMmHighestUserAddress: Pointer;
                uKeActiveProcessors: ULONG;
                bKeNumberProcessors: byte;
                bUnknown2: byte;
                wUnknown3: word;
        end;

type
        TSystem_Performance_Information = packed record
        liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}
        dwSpare: array[0..75] of DWORD;
end;

type
        TSystem_Time_Information = packed record
        liKeBootTime: LARGE_INTEGER;
        liKeSystemTime: LARGE_INTEGER;
        liExpTimeZoneBias: LARGE_INTEGER;
        uCurrentTimeZoneId: ULONG;
        dwReserved: DWORD;
end;

var
        NtQuerySystemInformation: function(infoClass: DWORD;
        buffer: Pointer;
        bufSize: DWORD;
        returnSize: TPDword): DWORD; stdcall = nil;


        liOldIdleTime: LARGE_INTEGER = ();
        liOldSystemTime: LARGE_INTEGER = ();
        SysBaseInfo: TSystem_Basic_Information;
        SysPerfInfo: TSystem_Performance_Information;
        SysTimeInfo: TSystem_Time_Information;
        status: Longint; {long}
        dbSystemTime: Double;
        dbIdleTime: Double;
        //function GetCPUUsage:Double;

const
        {第一组:按钮内容选择}
        OKOnly=0;{仅显示"确定"按钮}
        OKCancel=1;{显示"确定"和"取消"按钮}
        AbortRetryIgnore=2;{"中止""重试""放弃"}
        YesNoCancel=3;{"是""否""取消"}
        YesNo=4;{"是"和"否"}
        RetryCancel=5;{"重试""取消"}
        {第二组:显示图标选择}
        Critical=16;{"STOP"图标}
        Question=32;{"?"图标}
        Excalamation=48;{"!"图标}
        Information=64;{"i"图标}
        {第三组:缺省指针位置(激活状态)}
        DefaultButton1=0;{第一按钮}
        DefaultButton2=256;{第二按钮}
        DefaultButton3=512;{第三按钮}
        {第四组:信息框方式}
        ApplicationModal=0;{应用方式}
        SystemModal=4096;{系统方式}

   //功  能: 将Pascal字符串转换成null结尾字符串函数
   function StrToPch(Str:string):PChar;
   //功  能: 消息框
   function MsgBox(msg:string;mbType:Word;title:string):Word;

   //功  能: 拷贝文件
   function CopyF(var ExistingFileName:string;const NewFileName:string;var
        Mode:Integer):Boolean;
   {************************************}
   //功  能: 得到进程号
   function GetProID(ProName:String):int64;
   //功  能: 杀死进程
   procedure KillProByName(proname:String);
   //功  能: 将字符转换成大写
   function UP(var str:String):String;
   //功  能: 避免调试
   function EnableDebugPrivilege: Boolean;
   //功  能: 杀死进程
   function KillTask(ExeFileName: string): Integer;
   //功  能: 取得一台机器的CPU占用率
   function GetCPUUsage:Double;
   //功  能: 取得用户名称
   function GetUserName: AnsiString;
   //功  能: 取得 Windows 产品序号
   function GetWindowsProductID: string;
   //功  能: 屏蔽系统按键
   Function ShieldSyskeystoke(State:Integer):Boolean;
   //隐藏Windows的任务条
   procedure hideTaskbar(Title:String);
   //功  能: 显示Windows的任务条
   procedure showTaskbar(Title:String);
   //功  能: 驱动器容量
   Procedure ShowDriverContent(Driver:PChar;var AllContent,DoContent:PChar);
   //重定向一个DOS应用程序
   function CreateDOSProcessRedirected(const CommandLine, InputFile,
      OutputFile, ErrMsg :string):boolean;
 
implementation


{=================================================================
  功  能: 将Pascal字符串转换成null结尾字符串函数
  参  数: Str 原字符串
  返回值: PChar
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function StrToPch(Str:string):PChar;
var
        a:PChar;
begin
        a:=StrAlloc(Length(Str)+1);
        StrPCopy(a,Str);
        StrToPch:=a;
end;

{=================================================================
  功  能: 消息框
  参  数: msg 消息
          mbType 按钮类型
          title 标题
  返回值: Word
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function MsgBox(msg:string;mbType:Word;title:string):Word;
var     hWnd1:HWND;
        pText,pCaption:Pchar;
begin
        pText:=StrToPch(title);
        pCaption:=StrToPch(msg);
        hWnd1:=GetActiveWindow();
        MsgBox:=MessageBox(hWnd1,pText,pCaption,mbType);
end;

{=================================================================
  功  能: 拷贝文件
  参  数: ExistingFileName 原文件名(包含路径)
          NewFileName 新的文件名(包含路径)
          Mode 模式
  返回值: false 失败,true 成功
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function CopyF(var ExistingFileName:string;const NewFileName:string;var
        Mode:Integer):Boolean;
var
        EFile,NFile:PChar;
        CpFlag,FailIfExists:Boolean;
        msg:string;
        ErrID,mbType:integer;
begin
        EFile:=StrToPch(ExistingFileName);
        NFile:=StrToPch(NewFileName);
        if (Mode=1) or (Mode=3) then
                FailIfExists:=True
        else
                FailIfExists:=False;
        CpFlag:=CopyFile(EFile,NFile,FailIfExists);
        if not CpFlag then
        begin
                ErrID:=GetLastError();
                ExistingFileName:=SysErrorMessage(ErrID);
                if Mode<2 then
                begin
                        msg:='CopyFile Error!';
                        mbType:=OKOnly+Excalamation;
                        MsgBox(msg,mbType,ExistingFileName);
                end;
                Mode:=ErrID;
        end;
        CopyF:=CpFlag;
end;


{=================================================================
  功  能: 将字符转换成大写
  参  数: str 字符串
  返回值: 转换成大写的字符串
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function UP(var str:String):String;
var j:integer;
begin
  try
    for j := 1 to length(str) do
      str[j] := UpCase(str[j]);
  except
  end;
end;

{=================================================================
  功  能: 避免调试
  参  数: 无
  返回值: false 失败,true 成功
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function EnableDebugPrivilege: Boolean;
  function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
  var
    TP: TOKEN_PRIVILEGES;
    Dummy: Cardinal;
  begin
    TP.PrivilegeCount := 1;
    LookupPrivilegevalue(nil, pchar(PrivName), TP.Privileges[0].Luid);
    if bEnable then
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else TP.Privileges[0].Attributes := 0;
    AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
    Result := GetLastError = ERROR_SUCCESS;
  end;

var
  hToken: Cardinal;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);

  if EnablePrivilege(hToken, 'SeDebugPrivilege', True) then
        ShowMessage('OK');
       
  CloseHandle(hToken);
end;

{=================================================================
  功  能: 杀死进程
  参  数: ExeFileName:String 程序名
  返回值: Integer 小于0则删除失败,大于0则删除成功
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
        OpenProcess(PROCESS_TERMINATE,
        BOOL(0),
        FProcessEntry32.th32ProcessID),
        0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


{=================================================================
  功  能: 得到进程号
  参  数: ProName:String 程序名
  返回值: int64 进程号
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function GetProID(ProName:String):int64;
var //p: pProcessInfo;
    ContinueLoop: BOOL;
    FSnapshotHandle: THandle;
    FProcessEntry32: TProcessEntry32;
    tmp:String;
begin
  result:=0;
  try
    Up(ProName);
    FSnapshotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
    FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
    while ContinueLoop do
    begin
      //New(p);
      tmp:=FProcessEntry32.szExeFile;
      Up(tmp);
      if ProName=tmp then
      begin
        result:= FProcessEntry32.th32ProcessID;
        break;
      end;
      ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
  except
  end;
end;

{=================================================================
  功  能: 杀死进程
  参  数: ProName:String 程序名
  返回值: 无
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
procedure KillProByName(proname:String);
var
  HProcess: Thandle;
  uExitCode: int64;
  ID:int64;
begin
  try
    ID := GetProID(proname);
    if ID > 0 then
      hProcess := openprocess(PROCESS_TERMINATE,FALSE,ID);
    if TerminateProcess(hProcess,3838) then
    begin
        Application.MessageBox('删除进程成功.', 'Look', MB_OK);
    end;
  except
  end;
end;

 

function Li2Double(x: LARGE_INTEGER): Double;
begin
        Result := x.HighPart * 4.294967296E9 + x.LowPart
end;

{=================================================================
  功  能: 取得一台机器的CPU占用率
  参  数: 无
  返回值: CPU占用率
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function GetCPUUsage:Double;
var
        bLoopAborted : boolean;
begin
        if @NtQuerySystemInformation = nil then
                NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
                        'NtQuerySystemInformation');

        status := NtQuerySystemInformation(SystemBasicInformation
                , @SysBaseInfo, SizeOf(SysBaseInfo), nil);
        if status <> 0 then Exit;

        bLoopAborted := False;
        while not bLoopAborted do
        begin

                status := NtQuerySystemInformation(SystemTimeInformation
                        , @SysTimeInfo, SizeOf(SysTimeInfo), 0);
                if status <> 0 then Exit;

                status := NtQuerySystemInformation(SystemPerformanceInformation
                        , @SysPerfInfo, SizeOf(SysPerfInfo),
                        nil);
                if status <> 0 then Exit;

                if (liOldIdleTime.QuadPart <> 0) then
                begin

                        dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
                        dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);

                        dbIdleTime := dbIdleTime / dbSystemTime;

                        dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;

                        Result:=dbIdleTime;
                        bLoopAborted:=True;

                end;
        // store new CPU‘s idle and
        End;
End;

{=================================================================
  功  能: 取得用户名称
  参  数: 无
  返回值: 用户名称
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function GetUserName: AnsiString;
var
        lpName: PAnsiChar;
        lpUserName: PAnsiChar;
        lpnLength: DWORD;
begin
        Result := '';
        lpnLength := 0;
        WNetGetUser(nil, nil, lpnLength); // 取得字串所需的长度
        if lpnLength > 0 then
        begin
                GetMem(lpUserName, lpnLength);
                if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR then
                        Result := lpUserName;
                FreeMem(lpUserName, lpnLength);
        end;
end; { GetUserName }


{=================================================================
  功  能: 取得 Windows 产品序号
  参  数: 无
  返回值: Windows 产品序号
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function GetWindowsProductID: string;
var
        reg: TRegistry;
begin
        Result := '';
        reg := TRegistry.Create;
        with reg do
        begin
                RootKey := HKEY_LOCAL_MACHINE;
                OpenKey('Software/Microsoft/Windows/CurrentVersion', False);
                Result := ReadString('ProductID');
        end;
        reg.Free;
End;


{=================================================================
  功  能: 屏蔽系统按键
  参  数: State 状态
  返回值: Boolean(成功:  True  失败:  False)
  备 注:也许你希望程序在运行时不想让用户按系统按键 Alt-Tab
        或 Ctrl-Alt-Del,那么可以通过以下的程序来屏蔽这些按键。
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
Function ShieldSyskeystoke(State:Integer):Boolean;
var tmp,Flag :integer;
Begin
        Result:=False;
        tmp := 0;
        Flag := 1;
        Case State Of
                1:Begin
                        SystemParametersInfo(SPI_SETFASTTASKSWITCH, Flag, @tmp, 0); //屏蔽 Alt-Tab
                        Result:=True;
                  End;
                2:Begin
                        SystemParametersInfo(SPI_SCREENSAVERRUNNING,Flag, @tmp, 0);//屏蔽 Ctrl-Alt-Del
                        Result:=True;
                  End;
        Else
                Result:=False;
        End;
End;

{=================================================================
  功  能: 隐藏Windows的任务条
  参  数: Title 标题条
  返回值: 无
  备 注:找到标题条的句
        柄,然后向它发送相应消息(SW_HIDE)即可
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
procedure hideTaskbar(Title:String);
var     wndHandle : THandle;
        wndClass : array[0..50] of Char;
begin
        StrPCopy(@wndClass[0], Title);//'Shell_TrayWnd');
        wndHandle := FindWindow(@wndClass[0], nil);
        ShowWindow(wndHandle, SW_HIDE);
End;

{=================================================================
  功  能: 显示Windows的任务条
  参  数: Title 标题条
  返回值: 无
  备 注:找到标题条的句
        柄,然后向它发送相应消息(SW_RESTORE)即可
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
procedure showTaskbar(Title:String);
var     wndHandle : THandle;
        wndClass : array[0..50] of Char;
begin
        StrPCopy(@wndClass[0], Title);//'Shell_TrayWnd');
        wndHandle := FindWindow(@wndClass[0], nil);
        ShowWindow(wndHandle, SW_RESTORE);
end;

{=================================================================
  功  能: 驱动器容量
  参  数: Driver 驱动器(要显示的驱动器名,如:driver:='c:/';)
  返回值: String(驱动器容量)
  备 注:要得到驱动器的容量和剩余容量,用下面的程序
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
Procedure ShowDriverContent(Driver:PChar;var AllContent,DoContent:PChar);
var
        sec1, byt1, cl1, cl2:Longword;
        AllStr,DoString:String;
Begin
        GetDiskFreeSpace(Driver, sec1, byt1, cl1, cl2);
        cl1 := cl1 * sec1 * byt1;
        cl2 := cl2 * sec1 * byt1;

        AllStr:=Formatfloat('###,##0',cl2);//'该驱动器总共容量' + Formatfloat('###,##0',cl2) + '字节';
        DoString:=Formatfloat('###,##0',cl1);//'该驱动器可用容量' + Formatfloat('###,##0',cl1) + '字节';
        AllContent:=PChar(AllStr);
        DoContent:=PChar(DoString);        
End;


{=================================================================
  功  能        : 重定向一个DOS应用程序
  描述          : executes a (DOS!) app defined in the CommandLine
                  parameter redirected to take input from InputFile
                  and give output to OutputFile
 返回值         : True on success
 参  数         :
                  CommandLine : the command line for the app,
                                including its full path
                  InputFile   : the ascii file where from the app
                                takes input
                  OutputFile  : the ascii file to which the app's
                                output is redirected
                  ErrMsg      : additional error message string.
                                Can be empty
 Error checking : YES
 Target         :
 版 本          :1.0  2005-10-18 9:05
 备 注          :
 例程           :
      CreateDOSProcessRedirected('C:/MyDOSApp.exe',
                                 'C:/InputPut.txt',
                                 'C:/OutPut.txt',
                                 'Please, record this message')
=================================================================}
function CreateDOSProcessRedirected(const CommandLine, InputFile,
     OutputFile, ErrMsg :string):boolean;
const
  ROUTINE_ID = '[function: CreateDOSProcessRedirected ]';
var
  OldCursor     : TCursor;
  pCommandLine  : array[0..MAX_PATH] of char;
  pInputFile,
  pOutPutFile   : array[0..MAX_PATH] of char;
  StartupInfo   : TStartupInfo;
  ProcessInfo   : TProcessInformation;
  SecAtrrs      : TSecurityAttributes;
  hAppProcess,
  hAppThread,
  hInputFile,
  hOutputFile   : THandle;
begin
  Result := False;
  { Check for InputFile existence }
  if not FileExists(InputFile)
  then
raise Exception.CreateFmt(ROUTINE_ID          + #10 +  #10 +
                              'Input file * %s *' + #10 +
                              'does not exist'    + #10 +  #10 +
                              ErrMsg, [InputFile]);
  { Save the cursor }
  OldCursor     := Screen.Cursor;
  Screen.Cursor := crHourglass;
  { Copy the parameter Pascal strings to null terminated
strings }
  StrPCopy(pCommandLine, CommandLine);
  StrPCopy(pInputFile, InputFile);
  StrPCopy(pOutPutFile, OutputFile);
  TRY
{ Prepare SecAtrrs structure for the CreateFile calls.
      This SecAttrs structure is needed in this case because
      we want the returned handle can be inherited by child
      process. This is true when running under WinNT.
      As for Win95, the documentation is quite ambiguous }
FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);
SecAtrrs.nLength              := SizeOf(SecAtrrs);
SecAtrrs.lpSecurityDescriptor := nil;
SecAtrrs.bInheritHandle       := True;
{ Create the appropriate handle for the input file }

hInputFile := CreateFile(pInputFile,
                        {pointer to name of the file }
                        GENERIC_READ or GENERIC_WRITE,
                        {access (read-write) mode }
                        FILE_SHARE_READ or FILE_SHARE_WRITE,
                        {share mode }
                        @SecAtrrs,
                        {pointer to security attributes }
                        OPEN_ALWAYS,
                        {how to create }
                        FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH,
                        { file attributes }
                        0 ); {handle to file with attributes to copy }
{ Is hInputFile a valid handle? }
if hInputFile = INVALID_HANDLE_VALUE
then
      raise Exception.CreateFmt(ROUTINE_ID + #10 +  #10 +
            'WinApi function CreateFile returned an' +
            'invalid handle value'  + #10 +
            'for the input file * %s *' + #10 + #10 +
            ErrMsg, [InputFile]);
{ Create the appropriate handle for the output file }
hOutputFile := CreateFile(pOutPutFile,
                        {pointer to name of the file }
                        GENERIC_READ or GENERIC_WRITE,
                        {access (read-write) mode }
                        FILE_SHARE_READ or FILE_SHARE_WRITE,
                        {share mode }
                        @SecAtrrs,
                        {pointer to security attributes }
                        CREATE_ALWAYS,
                        { how to create }
                        FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH,
                        {file attributes }
                        0 );
                        {handle to file with attributes to copy }
                       
{ Is hOutputFile a valid handle? }
if hOutputFile = INVALID_HANDLE_VALUE
then
      raise Exception.CreateFmt(ROUTINE_ID + #10 +  #10 +
            'WinApi function CreateFile returned an' +
            'invalid handle value'  + #10 +
            'for the output file * %s *' + #10 + #10 +
            ErrMsg, [OutputFile]);
{ Prepare StartupInfo structure }
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb          := SizeOf(StartupInfo);
StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or
                               STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdOutput  := hOutputFile;
StartupInfo.hStdInput   := hInputFile;
{ Create the app }
Result := CreateProcess(nil,                          
           { pointer to name of executable module }
        pCommandLine,                 
           { pointer to command line string }
        nil,                          
           { pointer to process security attributes }
        nil,                          
           { pointer to thread security attributes }
        True,                         
           { handle inheritance flag }
        HIGH_PRIORITY_CLASS,          
           { creation flags }
        nil,                          
           { pointer to new environment block }
        nil,                          
           { pointer to current directory name }
        StartupInfo,                  
           { pointer to STARTUPINFO }
        ProcessInfo);                 
           { pointer to PROCESS_INF }
{ wait for the app to finish its job and take the
      handles to free them later }
if Result
then
      begin
        WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
        hAppProcess  := ProcessInfo.hProcess;
        hAppThread   := ProcessInfo.hThread;
      end
else
      raise Exception.Create(ROUTINE_ID          + #10 +  #10 +
                             'Function failure'  + #10 +  #10 +
                             ErrMsg);
  FINALLY
{ Close the handles.
      Kernel objects, like the process and the files
      we created in this case, are maintained by a usage
      count.  So, for cleaning up purposes, we have to
      close the handles to inform the system that we don't
      need the objects anymore }
if hOutputFile <> 0 then CloseHandle(hOutputFile);
if hInputFile <> 0 then CloseHandle(hInputFile);
if hAppThread <> 0 then CloseHandle(hAppThread);
if hAppProcess <> 0 then CloseHandle(hAppProcess);
{ Restore the old cursor }
Screen.Cursor:= OldCursor;
  END;
end;    { CreateDOSProcessRedirected }

 

{=================================================================
  功  能: 提取当前光标下的单词
  参  数:
  返回值:
  备 注: 这个函数能够用来提取当前光标下的单词:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}
function RECharIndexByPos(Memo: TMemo;X, Y: Integer): Integer;
{ function returns absolute character position }
{ for given cursor coordinates }
var
  P: TPoint;
begin
  P := Point(X, Y);
  Result := SendMessage(Memo.Handle,EM_CHARFROMPOS, 0, longint(@P));
end;


{=================================================================
  功  能:
  参  数:
  返回值:
  备 注:
  版 本:
     1.0  2005-10-18 9:05
=================================================================}


var mstrmResFile:TMemoryStream;

procedure ParseResFile;

   function GetTypeName(  bConvertToType : boolean;  piVal : pointer  ) : string;
   var
      w : WORD;
      wc : WideChar;
   begin
      Result := '';

      /////////////////////////////////////////////////////////////////////
      // Get the type or name,  which is either a integer or a WideString
      ////////////////////////////////////////////////////////////////////
         {Get the first byte of the type/name.  If this is 0xFFFF then the
           following byte is the resource type/name. If it is not, then
           this is the first byte of the first char of the type/name}
      mstrmResFile.Read(  w,  2  );

      if(  w = $FFFF  ) then
      begin
            {Get the type/name}
         mstrmResFile.Read(  w,  2  );

         if(  piVal <> nil  ) then
            integer(piVal^) := w;

         if(  bConvertToType  ) then
         begin
            case(  w  ) of
                1 : Result := 'RT_CURSOR';
                2 : Result := 'RT_BITMAP';
                3 : Result := 'RT_ICON';
                4 : Result := 'RT_MENU';
                5 : Result := 'RT_DIALOG';
                6 : Result := 'RT_STRING';
                7 : Result := 'RT_FONTDIR';
                8 : Result := 'RT_FONT';
                9 : Result := 'RT_ACCELERATOR';
               10 : Result := 'RT_RCDATA';
               12 : Result := 'RT_GROUP_CURSOR';
               14 : Result := 'RT_GROUP_ICON';

               11 : Result := 'RT_MESSAGETABLE';
               16 : Result := 'RT_VERSION';
               17 : Result := 'RT_DLGINCLUDE';
               19 : Result := 'RT_PLUGPLAY';
               20 : Result := 'RT_VXD';
               21 : Result := 'RT_ANICURSOR';
            else
               Result := '??  ' + IntToStr(  w  );
            end;
         end
         else
            Result := IntToStr(  w  );
      end
      else begin
         if(  piVal <> nil  ) then
            integer(piVal^) := -1;

            {'Undo' last read}
         mstrmResFile.Position := mstrmResFile.Position - 2;

         repeat
               {Get a char}
            mstrmResFile.Read(  wc,  sizeof( WideChar )  );
               {Add char to the string}
            Result := Result + wc;

            {Was the last char read the NULL terminator?}
         until(  integer(wc) = 0  );
      end;
   end;


   function GetPadAmount(  iVal : integer  ) : integer;
   begin
      Result := 0;

      while(  (iVal mod 4) <> 0  ) do
      begin
         inc(  iVal  );
         inc(  Result  );
      end;
   end;

var
   li : TListItem;
   sType : string;
   sName : string;
   iTypeVal : integer;
   iDataSize : integer;
   iHeaderSize : integer;
   iHeaderOffset : integer;
begin
      {Clear current items}
   //lv_ResTypes.Items.BeginUpdate;
   //lv_ResTypes.Items.Clear;
   //lv_ResTypes.Items.EndUpdate;

   if(  mstrmResFile = nil  ) then
      Exit;

   mstrmResFile.Position := 0;

      {32bytes for empty record}
   if(  mstrmResFile.Size < 32  ) then
   begin
      ShowMessage(  'File too small'  );
      Exit;
   end;

      {Skip over header}
   mstrmResFile.Position := 32;

      {Parse the file}
   while(  mstrmResFile.Position < mstrmResFile.Size  ) do
   begin
         {Save offset of the header}
      iHeaderOffset := mstrmResFile.Position;

         {Get the data size}
      mstrmResFile.Read(  iDataSize,  4  );
         {Get the header size}
      mstrmResFile.Read(  iHeaderSize,  4  );
         {Get the type}
      sType := GetTypeName(  true,  @iTypeVal  );
         {Get the name}
      sName := GetTypeName(  false,  nil  );

         {Add to the list view}

      //li := lv_ResTypes.Items.Add;
      li.Caption := IntToStr(  iHeaderOffset  );
      li.SubItems.Add(   IntToStr(  iHeaderSize  )   );
      li.SubItems.Add(  sType  );
      li.SubItems.Add(  sName  );
      li.Data := pointer(iTypeVal);

         {Go to end of header}
      mstrmResFile.Position := iHeaderOffset + iHeaderSize;

         {Go to end of data (ie to next header, if there is one)
           Remember to move over any alignment bits}
      mstrmResFile.Position := mstrmResFile.Position + iDataSize + GetPadAmount(  iDataSize  );
   end;
end;


end.

WinApi手册

  • 2012年03月30日 10:37
  • 662KB
  • 下载

c++利用winapi实现简单多线程

#include #include #include using namespace std; DWORD WINAPI FUN1Proc(LPVOID lpParameter); //线程函数入...
  • u011575841
  • u011575841
  • 2016年11月10日 15:33
  • 1578

winapi消息大全

这几天一直在搞winapi 搞得头昏脑胀,找到了个消息大全感觉蛮好的,在此贴出: //////////////////////////////////////////////////////////...
  • xsg_BK
  • xsg_BK
  • 2015年09月18日 09:28
  • 1263

在函数前面加上WINAPI、CALLBACK

一直搞不懂为什么在函数前面加上WINAPI、CALLBACK等是什么意思 又不是返回值 为什么加在前面 今天终于知道了这是一个呼叫声明(姑且称之吧)。 引子: 看看这个函数: int PASCA...
  • qq_28098067
  • qq_28098067
  • 2016年01月26日 19:59
  • 1537

C语言中的一些winapi函数!

这篇文章,我将从最基本的开始谈起。但希望可以涉及更广的层面,而不仅仅是为你的程序除错(debug)。你将会看到,我认为除错(debugging)这个字的全部意义,并不只是通过ide的内建机制来运行的。...
  • u012402926
  • u012402926
  • 2015年10月23日 10:22
  • 459

最简单的Windows窗口程序,使用main函数,隐藏控制台等,适合window编程入门

#include #pragma comment( linker, "/subsystem:\"windows\" /entry:\"mainCRTStartup\"" ) //隐藏控制台用,注掉后...
  • fg5823820
  • fg5823820
  • 2013年11月22日 05:41
  • 3221

[WinAPI] 获取窗口句柄的几种方法

http://www.cnblogs.com/zjutlitao/p/3889900.html 1、使用FindWindow函数获取窗口句柄 示例:使用FindWindow函数获取窗口...
  • dszgf5717
  • dszgf5717
  • 2017年03月01日 14:57
  • 819

黑客常用WinAPI函数整理

黑客常用WinAPI函数整理   之前的博客写了很多关于Windows编程的内容,在Windows环境下的黑客必须熟练掌握底层API编程。为了使读者对黑客常用的Windows API有个更全面...
  • Chinamming
  • Chinamming
  • 2014年02月08日 21:25
  • 911

WinAPI编程入门笔记

今天写的这篇文章的主要意图就是给winAPI编程实践的一个小小的启发; 因为winAPI编程时,我们用到很多的函数都是带有很多的参数,而且有时要进行相应的强制类型转换,所以熟悉常用的一些类型是非常重...
  • fucumt
  • fucumt
  • 2013年01月27日 22:30
  • 9865

定时式获取鼠标处xy坐标和窗口对象(winapi)

看了一下.hook比较麻烦.反正弄个小东西,就使用了这个方式;  #include /* * ini解析模块 * 下载地址:http://ndevilla.free.fr/iniparser/ * 使...
  • qidizi
  • qidizi
  • 2013年04月09日 21:06
  • 655
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:WinAPI函数库
举报原因:
原因补充:

(最多只允许输入30个字)