摘要：function GetFileCount(ThePath,Ext:string):integer;varnum:integer;sr:TSearchRec;beginnum :=0;if ThePath[length(ThePath)]<>'\' thenThePath :=ThePath+'\';if (FindFirst(ThePath+Ext,faAnyFile,sr)=0 thenbeginnum :=num+1;while (FindNext(sr)=0) donum :=num+1;end;result :=num;end;end; 阅读全文

摘要：function GetDirCount(ThePath:string):integerfunction IsValidDir(SearchRec:TSearchRec):Boolean;beginif (SearchRec.Attr=16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'.'.) thenResult :=TrueelseResult :=False;end;varnum:integer;sr:TSearchRec;beginnum :=0;if (FindFirst(T 阅读全文

摘要：一 编写回调函数代码typeTCallBackFunction=function(s:string):integer;CallMe(s:string):integer;procedure TestCallBack(CllBackFunction:TCallBackFunction);far;external 'Other';function CallMe(s:pchar):integer;beginCallMe :=Length(Strpas(strpas(s)));end;procedure Form1.Button1Click(Sender:TObject);beginTe 阅读全文

摘要：procedure ReplaceStrToStrings(AStrings:TStrings;sToken,sRep:string);vari,j:integer;beginfor i:=0 to AStrings.count-1 dobegins:=AStrings[i];j:=Pos(sToken,s);if (j>0) thenbegins:=Copy(s,1,j-1)+sRep+Copy(s,j+length(sToken),length(s)-(j+length(sToken)));AStrings[i] :=s;end;end;end; 阅读全文

摘要：procedure DeleteFiles(Handle:THandle;Source:string);varFO:TShFileOpStruct;beginFillChar(FO,Sizeof(FO),#0);FO.wnd:=handle;FO.wFunc :=FO_Delete;FO.flags:=FOF_NOCONFINFORMATION;FO.pFrom :=PChar(Source);SHFileOperation(FO);end;end; 阅读全文

摘要：procedure MoveFile(Handle:THandle;Source,Dest:string);varFO:TShFileOpStruct;beginFillChar(FO,Sizeof(FO),#0);FO.wnd :=Handle;FO.wFunc :=FO_Move;FO.flags :=FOF_NoCONFIFMATION;FO.pFrom :=pchar(Source+#0#0);PO.pTo :=pchar(Dest+#0#0);ShFileOperation(FO);end; 阅读全文

摘要：//分解文件夹 SDir:源目录名 DDir:目的目录名 SQZ:生成的子目录(前)后缀名//SExt：文件类型 MNum:每个文件夹的文件数目 B:SQZ为前缀还是后缀名procedure CutDir(SDir,DDir,SQZ,SExt:string;MNum:integer;B:Boolean;handle:THandle);vari,iFileCount,iFileNum,iDirCount,iDirNum:integer;tsr:TStringList;DFileName,SFileName:string;bSearch:Boolean;beginbSearch:=False;ts 阅读全文

摘要：function SaveHTMLToStream(Astream:TStream):HResult;varIpStream:IpersistStreamInit;beginwith WebBrower2 dobeginwhile ReadState<>READYSTATE_COMPLETE doForms.Application.ProcessMessages;if Assigned(Document) thenbeginIpStream :=Document as IPersistStreamInit;Result :=IpStream.Save(TStreamAdapter. 阅读全文

摘要：procedure UseHtmlDialog(htmlName:string);vara,b:OleVariant;c:integer;begina:=0;b:=0;WebBrowser1.Navigate(htmlName);c:=WebBrowser1.QueryStatusWB(OLECMDID_SELECTALL);if c>0 thenWebBrowser2.ExecWB(OLECMID_SAVEAS,OLECMEXCOPY_DONTPROMPTUSER,EmptyParam,EmptyParam)elseShowmessage('命令不能执行');end; 阅读全文

摘要：首先在uses中加入ActiveX,MSHTML,OleCtrls,SHDocVw,然后编写代码procedure SaveHTMLSourceToFile(const FileName:string;WB:TWebBrowser);varPersistStream:IPersistStreamInit;FileStream:TFileStream;Stream:IStream;SaveResult:HResult;beginPersistStream :=WB.Document as IPersistStreamInit;FileStream :=TFileStream.Create(Fil 阅读全文

摘要：procedure SaveHtmlContentToTxt(htmlName,txtName:string);varlpf:IPersistFile;beginWebBrowser1.Navigate(htmlName);lpf:=WebBrowser1.Document sa IPersistFile;lpf.Save(pchar(txtName),True);end; 阅读全文

摘要：需添加UrlMon单元function DownloadFile(Source,Dest:string):boolean;begintryResult :=UrlDownloadFile(nil,pchar(Source),pchar(Dest),0,nil)=0;exceptResult :=False;end;end; 阅读全文

摘要：procedure GrayToColor(Bmp:TBitmap);vari,j,uG:integer;beginBmp.PixelFormat:=pf24Bit;for j:=0 to Bmp.Height-1 dobeginp:=Bmp.Scanline[j];for i:=0 to Bmp.Width-1 dobeginuG:=p[3*i];if (0<uG) and (uG<63) thenbeginp[3*i+2]:=0;p[3*i+1]:=254-4*uG;p[3*i]:=255;end;if (64<=uG) and (uG<127) thenbegin 阅读全文

摘要：use ShellApi;copyfile(pchar('newfile.txt',pchar('//computername/direction/target.txt'),false); 阅读全文

摘要：procedure Invert(Image:TImage);varBMP:TBitmap;beginBMP:=TBitmap.Create;tryBmp.Width :=Image1.Picture.Bitmap.Width;Bmp.Height:=Image1.Picture.Bitmap.Height;Bitblt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,Image.Picture.Bitmap.CanvasHandle,0,0,NoTSRCCCPY);Image.Picture.Bitmap.Assign(Bmp);finallyBmp.F 阅读全文

摘要：function SelectDir:stringvarInfo:TBrowseInfo;IDList:PItemIDList;Buffer:pchar;beginresult :='';Buffer:=StrAlloc(MAX_PATH);with Info dobeginhwndOwner:=Application.mainform.handle;pidRoot :=nil;pszDisplayName:=Buffer;lpszTitle:='请选择路径：';uFlags:=BIF_RETURNONLYFSDIRS; //如果加上OR BIF_BROWSEI 阅读全文

摘要：首先添加shlobj单元procedure CreateLink(ExePath,LinkName:WideString);vartmpObject:IUnknown;tmpSLink:IShellLink;PIDL:PItemIDList;tmpPFile:IPersistFile;StartupDirectory:array[0..MAXPATH] of char;LinkFileName:widestring;beginStartupFileName:=ExePath;tmpObject:=CreateObject(CLSID_ShellLink);tmpSLink:=tmpObject 阅读全文

摘要：procedure CloseWindow(Flag:integer);varhToken:Thandle;tkp,tkDumb:TTokenPrivileges;DoubInt:dword;beginif Win32PlatForm=VER_PLATFORM_WIN32_NT thenbeginFillChar(tkp,Sizeof(tkp),0);if (OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)) thenbegintkp.PrivilegeCount:=1;tkp.P 阅读全文

摘要：摘自盒子http://www.2ccc.com有任何疑问请到 http://yaoqiaofeng.blog.163.com 留言给我，由于本程序是以BDS2006编译的，所以BDS2006以前的版本打开时会提示属性错误，但没有关系，直接点击忽略即可，不会影响程序function EnableDebugPriv: Boolean;varhToken: THandle;tp: TTokenPrivileges;rl: Cardinal;beginResult := false;//打开进程令牌环OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_ 阅读全文