| « | December 2025 | » | | 日 | 一 | 二 | 三 | 四 | 五 | 六 | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | | | | |
|
公告 |
| 暂无公告... |
| Blog信息 |
|
blog名称:DeathCat的猫窝
日志总数:17
评论数量:89
留言数量:0
访问次数:218121
建立时间:2005年4月5日 |
| |
|
 [Delphi食堂]懒人函数 之 “朋友提供的函数”
网上资源, 软件技术
DeathCat 发表于 2005/4/6 11:38:03 |
| 全力感谢Ｓｅａ的帮忙，提供了这些函数～～
//-----取得快捷方式中的连接function ExeFromLink(const linkname: string): string; var FDir, FName, ExeName: PChar; z: integer; begin ExeName:= StrAlloc(MAX_PATH); FName:= StrAlloc(MAX_PATH); FDir:= StrAlloc(MAX_PATH); StrPCopy(FName, ExtractFileName(linkname)); StrPCopy(FDir, ExtractFilePath(linkname)); z:= FindExecutable(FName, FDir, ExeName); if z > 32 then Result:= StrPas(ExeName) else Result:= ''; StrDispose(FDir); StrDispose(FName); StrDispose(ExeName); end;
控制TCombobox的自动完成{'Sorted' property of the TCombobox to true } var lastKey: Word; //全局变量//TCombobox的OnChange事件 procedure Tform1.AutoCompleteChange(Sender: TObject); var SearchStr: string; retVal: integer; begin SearchStr := (Sender as TCombobox).Text; if lastKey <> VK_BACK then // backspace: VK_BACK or $08 begin retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr))); if retVal > CB_Err then begin (Sender as TCombobox).ItemIndex := retVal; (Sender as TCombobox).SelStart := Length(SearchStr); (Sender as TCombobox).SelLength := (Length((Sender as TCombobox).Text) - Length(SearchStr)); end; // retVal > CB_Err end; // lastKey <> VK_BACK lastKey := 0; // reset lastKey end; //TCombobox的onKeyDown事件procedure Tform1.AutoCompleteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin lastKey := Key; end;
如何清空一个目录 function EmptyDirectory(TheDirectory :String Recursive : Boolean) :Boolean;varSearchRec : TSearchRec;Res : Integer;beginResult := False;TheDirectory := NormalDir(TheDirectory);Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);trywhile Res = 0 dobeginif (SearchRec.Name <> '.') and (SearchRec.Name <> '..') thenbeginif ((SearchRec.Attr and faDirectory) > 0) and Recursivethen beginEmptyDirectory(TheDirectory + SearchRec.Name, True);RemoveDirectory(PChar(TheDirectory + SearchRec.Name));endelse beginDeleteFile(PChar(TheDirectory + SearchRec.Name))end;end;Res := FindNext(SearchRec);end;Result := True;finallyFindClose(SearchRec.FindHandle);end;end;
得到硬盘序列号var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char; begin if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^); end;
取得系统运行的进程名var hCurrentWindow:HWnd;szText:array[0..254] of char;beginhCurrentWindow:=Getwindow(handle,GW_HWndFrist);while hCurrentWindow <> 0 dobeginif Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);end;end;
程序不出现在ALT+CTRL+DEL在implementation后添加声明:function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏RegisterServiceProcess(GetCurrentProcessID, 0);//显示用ALT+DEL+CTRL看不见
程序不出现在任务栏uses windowsvarExtendedstyle : Integer;beginApplication.Initialize;//============================================================== Extendedstyle := GetWindowLong (Application.Handle, GWL_EXstyle);SetWindowLong(Application.Handle, GWL_EXstyle, Extendedstyle OR WS_EX_TOOLWINDOWAND NOT WS_EX_APPWINDOW);//=============================================================== Application.Createform(Tform1, form1);Application.Run;end.
处理“右键菜单”方法varreg: TRegistry;beginreg := TRegistry.Create;reg.RootKey:=HKEY_CLASSES_ROOT;reg.OpenKey('*\shell\check\command', true);reg.WriteString('', '"' + application.ExeName + '" "%1"');reg.CloseKey;reg.OpenKey('*\shell\diary', false);reg.WriteString('', '操作(&C)');reg.CloseKey;reg.Free;showmessage('DONE!');end;
[DELPHI]发送虚拟键值ctrl Vprocedure sendpaste;beginkeybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0);keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0);keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);end;
当前的光驱的盘符 procedure getcdrom(var cd:char);varstr:string;drivers:integer;driver:char;i,temp:integer;begindrivers:=getlogicaldrives;temp:=(1 and drivers);for i:=0 to 26 dobeginif temp=1 thenbegindriver:=char(i+integer('a'));str:=driver+':';if getdrivetype(pchar(str))=drive_cdrom thenbegincd:=driver;exit;end;end;drivers:=(drivers shr 1);temp:=(1 and drivers);end;end;
向其他应用程序发送模拟键varh: THandle;beginh := FindWindow(nil, '应用程序标题');PostMessage(h, WM_KEYDOWN, VK_F9, 0);//发送F9键end;
□◇[DELPHI]DELPHI 支持的DAO数据格式td.Fields.Append(td.CreateField ('dbBoolean',dbBoolean,0));td.Fields.Append(td.CreateField ('dbByte',dbByte,0));td.Fields.Append(td.CreateField ('dbInteger',dbInteger,0));td.Fields.Append(td.CreateField ('dbLong',dbLong,0));td.Fields.Append(td.CreateField ('dbCurrency',dbCurrency,0));td.Fields.Append(td.CreateField ('dbSingle',dbSingle,0));td.Fields.Append(td.CreateField ('dbDouble',dbDouble,0));td.Fields.Append(td.CreateField ('dbDate',dbDate,0));td.Fields.Append(td.CreateField ('dbBinary',dbBinary,0));td.Fields.Append(td.CreateField ('dbText',dbText,0));td.Fields.Append(td.CreateField ('dbLongBinary',dbLongBinary,0));td.Fields.Append(td.CreateField ('dbMemo',dbMemo,0));td.Fields['ID'].Set_Attributes(dbAutoIncrField);//自增字段
得到图像上某一点的RGB值procedure Tform1.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);varred,green,blue:byte i:integer;begini:= image1.Canvas.Pixels[x,y];Blue:= GetBvalue(i);Green:= GetGvalue(i): Red:= GetRvalue(i); Label1.Caption:=inttostr(Red);Label2.Caption:=inttostr(Green);Label3.Caption:=inttostr(Blue);end;
如何判断当前网络连接方式判断结果是MODEM、局域网或是代理服务器方式。uses wininet; Function ConnectionKind :boolean; var flags: dword; begin Result := InternetGetConnectedState(@flags, 0); if Result then begin if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then begin showmessage('Modem'); end; if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then begin showmessage('LAN'); end; if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then begin showmessage('Proxy'); end; if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then begin showmessage('Modem Busy'); end; end; end;
如何判断字符串是否是有效EMAIL地址function IsEMail(EMail: String): Boolean; var s: String;ETpos: Integer; begin ETpos:= pos('@', EMail); if ETpos > 1 then begin s:= copy(EMail,ETpos+1,Length(EMail)); if (pos('.', s) > 1) and (pos('.', s) < length(s)) then Result:= true else Result:= false; end else Result:= false; end;
判断系统是否连接INTERNET需要引入URL.DLL中的InetIsOffline函数。 函数申明为：function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL'; 然后就可以调用函数判断系统是否连接到INTERNETif InetIsOffline(0) then ShowMessage('not connected!') else ShowMessage('connected!'); 该函数返回TRUE如果本地系统没有连接到INTERNET。附：大多数装有IE或OFFICE97的系统都有此DLL可供调用。InetIsOfflineBOOL InetIsOffline(DWORD dwFlags, );
取机器BIOS信息with Memo1.Lines do begin Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061)))); Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091)))); Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5)))); Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71)))); end;
差不多也就这么多了～～～有用的上的就拿去用吧 |
|
|