DELPHI编程资料

NTDLL单元

[不指定 2007/02/02 16:55 | by OnlyBird ]
//I haven't seen them in the JEDI project. But here they are:
// ntdll.dll functions definitions - NT Native API
// Some of these functions are described in Win NT/2000 DDK (Rtl*,Zw* functions)
// see also http://www.sysinternals.com/ntdll.htm

unit ntdll;

interface

uses Windows;

type
   PLARGE_INTEGER = ^LARGE_INTEGER;

//-------------------------------------------------------------
type
   NTSTATUS = Longint;

const
   STATUS_SUCCESS           = NTSTATUS(0);

   STATUS_NO_MORE_DATA      = NTSTATUS($8000001a);
   STATUS_NO_MORE_FILES     = NTSTATUS($80000006);
   STATUS_INVALID_PARAMETER = NTSTATUS($C000000D);

function RtlNtStatusToDosError( const Status : NTSTATUS ) : DWORD; stdcall;

//-------------------------------------------------------------
// Counted String
type
   TNtAnsiString = packed record
        Length        : Word;
        MaximumLength : Word;
        Buffer        : PChar;
   end;
   PNtAnsiString = ^TNtAnsiString;
   ANSI_STRING = TNtAnsiString;

   TNtUnicodeString = packed record
        Length        : Word;
        MaximumLength : Word;
        Buffer        : PWideChar;
   end;
   UNICODE_STRING = TNtUnicodeString;
   PNtUnicodeString = ^TNtUnicodeString;

procedure RtlInitString( DestinationString : PNtAnsiString; SourceString : PChar ); stdcall;
procedure RtlInitAnsiString( DestinationString : PNtAnsiString; SourceString : PChar ); stdcall;
procedure RtlCopyString( DestinationString : PNtAnsiString; SourceString : PNtAnsiString ); stdcall;
function  RtlUpperChar ( Character : Char ) : Char; stdcall;
function  RtlCompareString( String1, String2 : PNtAnsiString; CaseInSensitive : Boolean ) : LongInt; stdcall;
function  RtlEqualString( String1, String2 : PNtAnsiString; CaseInSensitive : Boolean ) : Boolean; stdcall;
procedure RtlUpperString( DestinationString : PNtAnsiString; SourceString : PNtAnsiString ); stdcall;
procedure RtlFreeAnsiString( NtAnsiString : PNtAnsiString ); stdcall;

//-------------------------------------------------------------
// NLS String functions
procedure RtlInitUnicodeString( DestinationString : PNtAnsiString; SourceString : PWideChar ); stdcall;
function  RtlAnsiStringToUnicodeString( DestinationString : PNtUnicodeString; SourceString : PNtAnsiString; AllocateDestinationString : Boolean ) : NTSTATUS; stdcall;
function  RtlUnicodeStringToAnsiString( DestinationString : PNtAnsiString; SourceString : PNtUnicodeString; AllocateDestinationString : Boolean ) : NTSTATUS; stdcall;
function  RtlCompareUnicodeString( String1, String2 : PNtUnicodeString; CaseInSensitive : Boolean ) : LongInt; stdcall;
function  RtlEqualCompareUnicodeString( String1, String2 : PNtUnicodeString; CaseInSensitive : Boolean ) : Boolean; stdcall;
function  RtlPrefixUnicodeString( String1, String2 : PNtUnicodeString; CaseInSensitive : Boolean ) : Boolean; stdcall;
function  RtlUpcaseUnicodeString( DestinationString : PNtUnicodeString; SourceString : PNtUnicodeString; AllocateDestinationString : Boolean ) : NTSTATUS; stdcall;
procedure RtlCopyUnicodeString( DestinationString : PNtUnicodeString; SourceString : PNtUnicodeString ); stdcall;
function  RtlAppendUnicodeStringToString( DestinationString : PNtUnicodeString; SourceString : PNtUnicodeString ): NTSTATUS; stdcall;
function  RtlAppendUnicodeToString( DestinationString : PNtUnicodeString; SourceString : PWideChar ): NTSTATUS; stdcall;
function  RtlUpcaseUnicodeChar( SourceCharacter : WideChar ) : WideChar; stdcall;
procedure RtlFreeUnicodeString( UnicodeString : PNtUnicodeString ); stdcall;
function  RtlxAnsiStringToUnicodeSize( NtAnsiString : PNtAnsiString ) : DWORD; stdcall;
function  RtlAnsiStringToUnicodeSize( NtAnsiString : PNtAnsiString ) : DWORD; stdcall;


编程资料 | 评论(0) | 引用(0) | 阅读(853)

调用中断获取系统运行时间

[不指定 2007/02/02 16:51 | by OnlyBird ]

function GetSysTime:dword;
asm
 int $2a //调用2a号中断获取系统从启动运行时间(毫秒)
end;



procedure TForm1.Button1Click(Sender: TObject);
var
 hours:dword;//小时
 sec:dword;  //分钟
begin
 hours:=GetSysTime() div 3600000;
 sec:=GetSysTime() mod 3600000 div 60000;
 edit1.Text:='系统从启动运行了:'+inttostr(hours)+'小时'+inttostr(sec)+'分钟';
end;
编程资料 | 评论(0) | 引用(0) | 阅读(743)

列出当前系统运行的全部窗口

[不指定 2007/01/18 11:39 | by OnlyBird ]

function EnumWindowsFunc(Handle: THandle; List: TStringList):boolean; stdcall;
var
Caption: array[0..256] of Char;
begin
if GetWindowText(Handle, Caption, SizeOf(Caption)-1) <> 0 then
begin
List.Add(Caption);
//SetWindowText(Handle, PChar('About - ' + Caption));
end;
Result :=True;
end;



//用法
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
EnumWindows(@EnumWindowsFunc, LParam(Memo1.Lines));
end;
编程资料 | 评论(0) | 引用(0) | 阅读(728)

杂⑦杂㈧

[不指定 2006/12/26 01:28 | by OnlyBird ]
function   CanGetIECookie(const   URL:   string;   var   Cookie:   string):   boolean;  
 var  
 lpvBuffer:   array[0..1000]   of   byte;  
 lpdwBufferLength:   cardinal;  
 begin  
 lpdwBufferLength   :=   sizeof(lpvBuffer);  
 result   :=   InternetGetCookie(PChar(URL),   nil,   @lpvBuffer,   lpdwBufferLength);  
 if   result   then  
 Cookie   :=   pchar(@lpvBuffer);  
 end;  
   
 function   httpget(idhttp1:tidhttp):string;  
 var   url,str,cookiestr,temp:string;  
 begin  
 url:=   'http://www.e0575.cn/dispuser.asp?id=71002';  
 idhttp1.Request.Host:='www.e0575.cn';  
 idhttp1.Request.AcceptLanguage:='zh-cn';  
 idhttp1.Request.UserAgent:='Mozilla/4.0   (compatible;   MSIE   6.0;   Windows   NT   5.0;   MyIE2;   CustomExchangeBrowser;   .NET   CLR   1.1.4322)';  
 idhttp1.Request.ProxyConnection:='Keep-Alive'   ;  
 idhttp1.Request.ContentType:='text/html';  
 IdHTTP1.Request.ContentType   :=   'application/x-www-form-urlencoded';  
 idhttp1.AllowCookies:=true;  
   if   CanGetIECookie(url,str)     then  
     begin  
 CookieStr   :=   'Cookie:   '   +   str;  
 idHttp1.Request.CustomHeaders.Text   :=   CookieStr;  
     end;  
     try  
 temp:=idhttp1.Get(url);  
     except  
           application.MessageBox('correct   happened!','wrong',MB_iconerror+MB_OK);  
           application.Terminate;  
       end;  
   
   result:=temp;  
     idhttp1.Free;  
   
 end;  



中间函数
function CenterStr(Src:String;Before,After:String):String;
 var
   Pos1,Pos2:WORD;
 begin
   Pos1:=Pos(Before,Src)+Length(Before);
   Pos2:=Pos(After,Src);
   Result:=Copy(Src,Pos1,Pos2-Pos1);
 end;


function GetFileSize(const FileName: String): LongInt;
   var SearchRec: TSearchRec;
   begin
   if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
   else
    Result := -1;
   end;

function GetShortName(sLongName: string): string; //转换长文件名
var
sShortName: string;
nShortNameLen: integer;
begin
SetLength(sShortName, MAX_PATH);
nShortNameLen := GetShortPathName(PChar(sLongName),
PChar(sShortName), MAX_PATH - 1);
if (0 = nShortNameLen) then
begin
// handle errors...
end;
SetLength(sShortName, nShortNameLen);
Result := sShortName;
end;











操作系统编程
更改Windows的墙纸。
　　在Delphi中你可以很方便地更改墙纸，请参考以下的程序。
　　procedureChangeIt；
　　var
　　Reg：TregIniFile；
　　begin
　　Reg：ΚTRegIniFile．Create（′ControlPanel′）；
　　Reg．WriteString（′desktop′，′Wallpaper′，′c：ιpwin95ιforest．bmp′）；
　　Reg．WriteString（′desktop′，′TileWallpaper′，′1′）；
　　Reg．Free；
　　SystemParametersInfo（SPI—SETDESKWALLPAPER，0，nil，SPIF—SENDWININICHANGE）；
　　end


设置系统日期和时间:
例如:
  var
     MyST:TSystemTime;
  begin
       with MyST do
       begin
            wYear:=1998;
            wMonth:=12;
            wDay:=7;
            wHour:=8;
            wMinute:=9;
            wSecond:=10;
       end;
       SetSystemTime(MyST);
  end;
s


如何隐藏和显示Windows的任务条.
如果隐藏和显示Windows的任务条?仅仅调用以下的函数就可以.
procedure hideTaskbar; //隐藏
var
wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
　
End;
　
procedure showTaskbar;
var
wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_RESTORE);
end;

编程资料 | 评论(0) | 引用(0) | 阅读(820)

取得系统特殊文件夹路径

[不指定 2006/12/07 03:32 | by OnlyBird ]

function GetSpecialFolderDir(const folderid:integer):string;
var
  pidl:pItemIDList;
  buffer:array [ 0..255 ] of char ;
begin
  //取指定的文件夹项目表
  SHGetSpecialFolderLocation( application.Handle , folderid, pidl);
  SHGetPathFromIDList(pidl, buffer);    //转换成文件系统的路径
  result:=strpas(buffer);
end;


其中：folderid可以取下面的值：但是请注意，有些是虚的文件夹，不是文件系统
的一部分，所以用SHGetPathFromIDList是取不出路径的，但是在此也列出了。打'*'
号的为不是真正的文件系统，应该用作它用。
  CSIDL_BITBUCKET         *   回收站
  CSIDL_CONTROLS          *   控制面板
  CSIDL_DESKTOP           *   桌面
  CSIDL_DESKTOPDIRECTORY      桌面目录       //如C:\WINDOWS\Desktop
  CSIDL_DRIVES            *   我的电脑
  CSIDL_FONTS                 字体           //如C:\WINDOWS\FONTS
  CSIDL_NETHOOD               网上邻居目录   //如C:\WINDOWS\NetHood
  CSIDL_NETWORK           *   网上邻居
  CSIDL_PERSONAL              我的文档       //如C:\My Documents
  CSIDL_PRINTERS          *   打印机
  CSIDL_PROGRAMS              程序组         //如C:\WINDOWS\Start Menu\Programs
  CSIDL_RECENT                最近文档       //如C:\WINDOWS\Recent
  CSIDL_SENDTO                发送到         //如C:\WINDOWS\SentTo
  CSIDL_STARTMENU             开始菜单       //如C:\WINDOWS\Start Menu
  CSIDL_STARTUP               启动           //如C:\WINDOWS\启动
  CSIDL_TEMPLATES             模版           //如C:\WINDOWS\ShellNew
编程资料 | 评论(0) | 引用(0) | 阅读(741)
分页： 1/3 第一页 1 2 3 下页 最后页 [ 显示模式： 摘要 | 列表 ]