델파이 유용한 함수정리 5탄

728x90

델파이 유용한 함수정리 5탄

전체경로 폴더생성

function ForceDirectories(Dir: string): Boolean;

procedure pCreateDir(sPath: string);

var s: string;

sList: TStrings;

i: Integer;

begin

s:= sPath;

if DirectoryExists(s) then

Exit;

sList:= TStringList.Create;

try

while pos('\',s) > 0 do

begin

sList.Add(Copy(s,1,Pos('\',s)));

Delete(s,1,Pos('\',s));

end;

if Length(s) > 0 then

sList.Add(s);

s:= '';

for i:= 0 to sList.Count - 1 do

begin

s:= s + sList[i];

if not DirectoryExists(s) then

begin

CreateDir(s);

end;

finally

sList.Free;

end;

바로가기 단축아이콘에서 실행파일경로명 구하기

uses

ShlObj, ActiveX, ComObj;

function ShortCutToExeFileName(ShortCutPath:String):string;

var

MyObject : IUnknown;

MySLink : IShellLink;

MyPFile : IPersistFile;

WFileName : WideString;

WFindData : TWin32FindDataA;

begin

MyObject := CreateComObject(CLSID_ShellLink);

MySLink := MyObject as IShellLink;

MyPFile := MyObject as IPersistFile;

Result := '';

WFileName := ShortCutPath + #0;

if MyPFile.Load(PWChar(WFileName), STGM_READ) = S_OK then

with MySLink do

begin

SetLength(WFileName, 255);

GetPath(PChar(WFileName), Length(WFileName), WFindData, SLGP_UNCPRIORITY);

Result := StrPas(PChar(WFileName));

end;

TextFile 읽기

var F: TextFile;

s: string;

begin

if OpenDialog1.Execute then

begin

AssignFile(F, OpenDialog1.FileName);

Reset(F);

Memo1.Lines.Clear;

while not Eof(F) do

begin

Readln(F, s);

Memo1.Lines.Add(s1);

end;

CloseFile(F);

end;

ShellExecute 예제

procedure ExecFile (const Filename: String);

begin

ShellExecute(0, nil, PChar(Filename), nil,

PChar(GetCurrentDir), SW_SHOWDEFAULT);

end;

사용 예) ExecFile ('C:\Windows\바탕 화면\ACDSee 32.lnk');

Path 환경설정 읽기

function GetEnvVar(const csVarName : string ) : string;

var pc1, pc2 : PChar;

begin

pc1 := StrAlloc( Length( csVarName )+1 );

pc2 := StrAlloc( cnMaxVarValueSize + 1 );

StrPCopy( pc1, csVarName );

GetEnvironmentVariableA(pc1, pc2, cnMaxVarValueSize );

Result := StrPas( pc2 );

StrDispose( pc1 );

StrDispose( pc2 );

end;

Internet으로부터 파일을 다운로드 하기

uses

URLMon;

if URLDownloadToFile(nil,

`http://www.crosswinds.net/~realmind/English/FAQ/mDF.html`,

`c:\HTML\Merlins Forge\mDF.html`, 0, nil) <> 0 then

MessageBox(Handle,

'An error ocurred while downloading the file.',

PChar(Application.Title), MB_ICONERROR or MB_OK);

INI화일 사용

uses Inifiles;

with TIniFile.Create('SinyFile.ini') do

try

WriteInteger('Position','Top' ,Top);

WriteInteger('Position','Width' ,Width);

WriteInteger('Position','Left' ,Left);

WriteInteger('Position','Height',Height);

finally

Free;

end;

with TIniFile.Create('SinyFile.ini') do

try

Top := ReadInteger('Position','Top',0);

Width := ReadInteger('Position','Width',800);

Left := ReadInteger('Position','Left',0);

Height := ReadInteger('Position','Height',570);

finally

Free;

end;

파일의 날짜시간알기

function GetFileDate(TheFileName: string): string;

var FHandle: integer;

begin

FHandle := FileOpen(TheFileName, 0);

try

Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));

finally

FileClose(FHandle);

end;

function GetFileLastAccessTime(sFileName: string): TDateTime;

var

ffd : TWin32FindData;

dft : DWord;

lft : TFileTime;

h : THandle;

begin

// get file information

h := Windows.FindFirstFile(PChar(sFileName), ffd);

if(INVALID_HANDLE_VALUE <> h)then

begin

// we're looking for just one file,

// so close our "find"

Windows.FindClose( h );

// convert the FILETIME to

// local FILETIME

FileTimeToLocalFileTime(

ffd.ftLastAccessTime, lft );

// convert FILETIME to

// DOS time

FileTimeToDosDateTime(lft,

LongRec(dft).Hi, LongRec(dft).Lo);

// finally, convert DOS time to

// TDateTime for use in Delphi's

// native date/time functions

Result := FileDateToDateTime(dft);

end;

화일을 마우스로 이동하기

선언부

procedure WMDROPFILES(var Message: TWMDROPFILES);

message WM_DROPFILES;

코딩부

procedure TForm1.FormCreate(Sender: TObject);

begin

{Let Windows know we accept dropped files}

DragAcceptFiles(Self.Handle, True);

end;

procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);

var

NumFiles: LongInt;

i: LongInt;

Buffer: array[0..255] of Char;

begin

{How many files are being dropped}

// NumFiles := DragQueryFile(Message.Drop, -1, nil, 0);

NumFiles := DragQueryFile(Message.Drop, 0, nil, 0);

{Accept the dropped files}

for i := 0 to (NumFiles - 1) do

begin

DragQueryFile(Message.Drop, i, @Buffer, SizeOf(Buffer));

Form1.Memo1.Lines.Add(Buffer);

end;

파일복사

procedure FileCopy( const SrcFile, TarFile: string );

begin

try

CopyFile(PChar(SrcFile),PChar(TarFile),false);

except

end;

// File_Copy(ed_ReadFn.Text, ed_saveFloder.Text);

function File_Copy(const sSrcFile, sTarFile: string; pro: TProgressBar): Integer;

var

SplitSize, ReadSize, iFileSize, iFilePos: integer;

readFn, writeFn: string;

fReadHdl, fWriteHdl: THandle;

fModified: TFileTime;

buffer: pchar;

begin

SplitSize := 1;

// if SplitSize < minAllowedSplitSize then exit; //something wrong!!

SplitSize := SplitSize*1024; //nb: was in Kb's

//get the name of the file to split...

readFn := sSrcFile;

if not fileexists(readFn) then

begin

result:= 1; //'File not Found...'

exit; //something wrong!!

end;

//get the 'target' folder (where split files are to be saved) ...

writeFn := sTarFile;

GetMem(buffer,SplitSize);

if buffer = nil then

begin

result:= 3; //'Out of Memory...';

exit; //something wrong!!

end;

try

//StatusBar1.SimpleText:= 'Splitting Files';

//Open source file for reading...

fReadHdl := FileOpen(readFn, fmOpenRead or fmShareDenyNone);

if fReadHdl < 1 then

begin

result:= 4; //'Can''t Open File...';

exit; //something wrong!!

end;

iFileSize:= GetFileSize(fReadHdl, nil);

if pro <> nil then

pro.Max:= iFileSize;

try

//get the checksum and write it to file...

//StatusBar1.SimpleText:= 'Creation Check sum';

// Checksum := GetChecksum(fReadHdl);

//cancel if escape pressed while getting Checksum...

//get the original file's datetime...

GetFileTime(fReadHdl,nil,nil,@fModified);

//top of loop /////////////////////////////////

fWriteHdl := FileCreate(sTarFile);

if fWriteHdl < 1 then

begin

result:= 5; //'Can''t Create File';

exit; //something wrong!!

end;

try

iFilePos:= 0;

repeat

//StatusBar1.SimpleText:= 'Splitting Files ' + inttostr(cnt);

ReadSize := FileRead(fReadHdl, Buffer^, SplitSize);

iFilePos:= iFilePos + ReadSize;

if pro <> nil then

begin

pro.Position:= iFilePos;

pro.Repaint;

end;

FileWrite(fWriteHdl, Buffer^, ReadSize);

until (ReadSize <> SplitSize);

//set to the original file's datetime...

SetFileTime(fWriteHdl,nil,nil,@fModified);

finally

FileClose(fWriteHdl);

end;

//bottom of loop //////////////////////////////

finally

FileClose(fReadHdl);

end;

finally

FreeMem(Buffer);

end;

result:= 0;

end;

화일 split / join

//전체소스

unitSplitJoin;

interface

uses

Windows,Messages,SysUtils,Variants,Classes,Dialogs,CommCtrl,CommDlg,

ShlObj,ShellApi,Mask,ComCtrls;

functionSplitFiles(constsFileName,sFolder:string;iSplitSize:Integer):Integer;Export;Stdcall;

functionJoinFiles(constsSaveFileName:string;sSplitFileName:TStrings;constbDeleteFile:boolean):Integer;Export;Stdcall;

implementation

//GetLongFilename()isreallyonlyneededwhenfilesaredropped

//ontotheSplitJoin.exeiconinExplorer,asExplorerusesthe

//8.3filenameformatinthecommandline...

functionGetLongFilename(constfn:string):string;

var

desktop:IShellFolder;

OlePath:array[0..MAX_PATH]ofWideChar;

pidl:PItemIDList;

dummy1,dummy2:ULONG;

StrRet:TStrRet;

begin

result:=fn;

if(length(fn)<4)or(fn[2]<>':')thenexit;

ifSHGetDesktopFolder(desktop)<>NOERRORthenexit;

StringToWideChar(fn,OlePath,MAX_PATH);

ifdesktop.ParseDisplayName(0,nil,OlePath,dummy1,pidl,dummy2)<>NOERRORthen

exit;

ifdesktop.GetDisplayNameOf(pidl,SHGDN_FORPARSING,StrRet)<>NOERRORthen

exit;

caseStrRet.uTypeof

STRRET_WSTR:Result:=WideCharToString(StrRet.pOleStr);

STRRET_OFFSET:Result:=PChar(UINT(Pidl)+StrRet.uOffset);

STRRET_CSTR:Result:=StrRet.cStr;

End;

end;

//--------------------------------------------------------------------------

functionDirectoryExists(constName:string):Boolean;

var

Code:Integer;

begin

Code:=GetFileAttributes(PChar(Name));

Result:=(Code<>-1)and(FILE_ATTRIBUTE_DIRECTORYandCode<>0);

end;

//--------------------------------------------------------------------------

//Toenablethe<Escape>keytostopsplittingorjoining...

functionEscapePressed:boolean;

var

Msg:TMsg;

begin

whilePeekMessage(Msg,0,WM_KEYDOWN,WM_KEYDOWN,PM_REMOVE)do

if(Msg.wParam=VK_ESCAPE)then

begin

//Form1.StatusBar1.SimpleText:='Cenceled';

result:=true;

exit;

end;

result:=false;

end;

//--------------------------------------------------------------------------

const

table:ARRAY[0..255]OFDWORD=

($00000000,$77073096,$EE0E612C,$990951BA,

$076DC419,$706AF48F,$E963A535,$9E6495A3,

$0EDB8832,$79DCB8A4,$E0D5E91E,$97D2D988,

$09B64C2B,$7EB17CBD,$E7B82D07,$90BF1D91,

$1DB71064,$6AB020F2,$F3B97148,$84BE41DE,

$1ADAD47D,$6DDDE4EB,$F4D4B551,$83D385C7,

$136C9856,$646BA8C0,$FD62F97A,$8A65C9EC,

$14015C4F,$63066CD9,$FA0F3D63,$8D080DF5,

$3B6E20C8,$4C69105E,$D56041E4,$A2677172,

$3C03E4D1,$4B04D447,$D20D85FD,$A50AB56B,

$35B5A8FA,$42B2986C,$DBBBC9D6,$ACBCF940,

$32D86CE3,$45DF5C75,$DCD60DCF,$ABD13D59,

$26D930AC,$51DE003A,$C8D75180,$BFD06116,

$21B4F4B5,$56B3C423,$CFBA9599,$B8BDA50F,

$2802B89E,$5F058808,$C60CD9B2,$B10BE924,

$2F6F7C87,$58684C11,$C1611DAB,$B6662D3D,

$76DC4190,$01DB7106,$98D220BC,$EFD5102A,

$71B18589,$06B6B51F,$9FBFE4A5,$E8B8D433,

$7807C9A2,$0F00F934,$9609A88E,$E10E9818,

$7F6A0DBB,$086D3D2D,$91646C97,$E6635C01,

$6B6B51F4,$1C6C6162,$856530D8,$F262004E,

$6C0695ED,$1B01A57B,$8208F4C1,$F50FC457,

$65B0D9C6,$12B7E950,$8BBEB8EA,$FCB9887C,

$62DD1DDF,$15DA2D49,$8CD37CF3,$FBD44C65,

$4DB26158,$3AB551CE,$A3BC0074,$D4BB30E2,

$4ADFA541,$3DD895D7,$A4D1C46D,$D3D6F4FB,

$4369E96A,$346ED9FC,$AD678846,$DA60B8D0,

$44042D73,$33031DE5,$AA0A4C5F,$DD0D7CC9,

$5005713C,$270241AA,$BE0B1010,$C90C2086,

$5768B525,$206F85B3,$B966D409,$CE61E49F,

$5EDEF90E,$29D9C998,$B0D09822,$C7D7A8B4,

$59B33D17,$2EB40D81,$B7BD5C3B,$C0BA6CAD,

$EDB88320,$9ABFB3B6,$03B6E20C,$74B1D29A,

$EAD54739,$9DD277AF,$04DB2615,$73DC1683,

$E3630B12,$94643B84,$0D6D6A3E,$7A6A5AA8,

$E40ECF0B,$9309FF9D,$0A00AE27,$7D079EB1,

$F00F9344,$8708A3D2,$1E01F268,$6906C2FE,

$F762575D,$806567CB,$196C3671,$6E6B06E7,

$FED41B76,$89D32BE0,$10DA7A5A,$67DD4ACC,

$F9B9DF6F,$8EBEEFF9,$17B7BE43,$60B08ED5,

$D6D6A3E8,$A1D1937E,$38D8C2C4,$4FDFF252,

$D1BB67F1,$A6BC5767,$3FB506DD,$48B2364B,

$D80D2BDA,$AF0A1B4C,$36034AF6,$41047A60,

$DF60EFC3,$A867DF55,$316E8EEF,$4669BE79,

$CB61B38C,$BC66831A,$256FD2A0,$5268E236,

$CC0C7795,$BB0B4703,$220216B9,$5505262F,

$C5BA3BBE,$B2BD0B28,$2BB45A92,$5CB36A04,

$C2D7FFA7,$B5D0CF31,$2CD99E8B,$5BDEAE1D,

$9B64C2B0,$EC63F226,$756AA39C,$026D930A,

$9C0906A9,$EB0E363F,$72076785,$05005713,

$95BF4A82,$E2B87A14,$7BB12BAE,$0CB61B38,

$92D28E9B,$E5D5BE0D,$7CDCEFB7,$0BDBDF21,

$86D3D2D4,$F1D4E242,$68DDB3F8,$1FDA836E,

$81BE16CD,$F6B9265B,$6FB077E1,$18B74777,

$88085AE6,$FF0F6A70,$66063BCA,$11010B5C,

$8F659EFF,$F862AE69,$616BFFD3,$166CCF45,

$A00AE278,$D70DD2EE,$4E048354,$3903B3C2,

$A7672661,$D06016F7,$4969474D,$3E6E77DB,

$AED16A4A,$D9D65ADC,$40DF0B66,$37D83BF0,

$A9BCAE53,$DEBB9EC5,$47B2CF7F,$30B5FFE9,

$BDBDF21C,$CABAC28A,$53B39330,$24B4A3A6,

$BAD03605,$CDD70693,$54DE5729,$23D967BF,

$B3667A2E,$C4614AB8,$5D681B02,$2A6F2B94,

$B40BBE37,$C30C8EA1,$5A05DF1B,$2D02EF8D);

//PKZipcompliant32bitCRCalgorithm

//AlgorithmcourtesyofEarlF.Glynn,andusedwithhiskindpermission...

functionCalcCRC32(p:pointer;ByteCount:dword):dword;

var

i:dword;

q:Pbyte;

begin

q:=p;

result:=$FFFFFFFF;

fori:=0toByteCount-1do

begin

result:=(resultshr8)xortable[q^xor(resultand$000000ff)];

inc(q);

//checkifescapepressedaftereachMbparsed...

//thisslowsthealgorithmalittlebutisnecessarytoallowtheuserto

//breakoutofthisfunctionasitmaytakesometimewithverylargefiles

if(imod$100000=0)andEscapePressedthen

begin

result:=$FFFFFFFF;

exit;

end;

result:=notresult;

end;

//--------------------------------------------------------------------------

functionGetChecksum(constFileHandle:THandle):DWORD;

var

mapHdl:THandle;

memPtr:Pointer;

begin

result:=$FFFFFFFF;//ie:assumeerror

memPtr:=nil;

mapHdl:=0;

try

mapHdl:=CreateFileMapping(FileHandle,nil,PAGE_READONLY,0,0,nil);

ifmapHdl=0thenexit;

memPtr:=MapViewOfFile(mapHdl,FILE_MAP_READ,0,0,0);

ifmemPtr=nilthenexit;

result:=CalcCRC32(memPtr,GetFileSize(FileHandle,nil));

finally

ifAssigned(memPtr)thenUnmapViewOfFile(memPtr);

ifmapHdl<>0thenCloseHandle(mapHdl);

end;

//---------------------------------------------------------------------

//CallfunctionSyntax

//vari:integer;

//begin

//i:=SplitFiles(ed_ReadFn.Text,ed_saveFloder.Text,StrToIntDef(ed_SplitSize.Text,0));

//caseiof

//0:StatusBar1.SimpleText:='SplitFinished';

//1:StatusBar1.SimpleText:='FilenotFound...';

//2:StatusBar1.SimpleText:='FoldernotFound...';

//3:StatusBar1.SimpleText:='OutofMemory...';

//4:StatusBar1.SimpleText:='Can''tOpenFile...';

//5:StatusBar1.SimpleText:='Can''tCreateFile';

//6:StatusBar1.SimpleText:='SplitFileSizeError';

//end;

functionSplitFiles(constsFileName,sFolder:string;iSplitSize:Integer):Integer;

var

cnt,SplitSize,ReadSize:integer;

Checksum:dword;

readFn,writeFn,splitFn:string;

fReadHdl,fWriteHdl:THandle;

fModified:TFileTime;

buffer:pchar;

begin

result:=0;

SplitSize:=iSplitSize;

//ifSplitSize<minAllowedSplitSizethenexit;//somethingwrong!!

ifSplitSize<5then

begin

result:=6;

exit;//somethingwrong!!

end;

SplitSize:=SplitSize*1024;//nb:wasinKb's

//getthenameofthefiletosplit...

readFn:=sFileName;

ifnotfileexists(readFn)then

begin

result:=1;//'FilenotFound...'

exit;//somethingwrong!!

end;

//getthe'target'folder(wheresplitfilesaretobesaved)...

writeFn:=sFolder;

ifnotdirectoryexists(writeFn)then

begin

result:=2;//'FoldernotFound...'

exit;//somethingwrong!!

end;

ifwriteFn[length(writeFn)]<>'\'thenwriteFn:=writeFn+'\';

//appendfilenametothetargetfolder...

writeFn:=writeFn+extractfilename(readFn);

GetMem(buffer,SplitSize);

ifbuffer=nilthen

begin

result:=3;//'OutofMemory...';

exit;//somethingwrong!!

end;

try

//StatusBar1.SimpleText:='SplittingFiles';

//Opensourcefileforreading...

fReadHdl:=FileOpen(readFn,fmOpenReadorfmShareDenyNone);

iffReadHdl<1then

begin

result:=4;//'Can''tOpenFile...';

exit;//somethingwrong!!

end;

try

//getthechecksumandwriteittofile...

//StatusBar1.SimpleText:='CreationChecksum';

Checksum:=GetChecksum(fReadHdl);

//cancelifescapepressedwhilegettingChecksum...

ifChecksum=$FFFFFFFFthenexit;

fWriteHdl:=FileCreate(writeFn+'.999');

iffWriteHdl>0then

try

FileWrite(fWriteHdl,Checksum,sizeof(Checksum));

finally

FileClose(fWriteHdl);

end;

//gettheoriginalfile'sdatetime...

GetFileTime(fReadHdl,nil,nil,@fModified);

cnt:=1;

//topofloop/////////////////////////////////

repeat

//StatusBar1.SimpleText:='SplittingFiles'+inttostr(cnt);

ReadSize:=FileRead(fReadHdl,Buffer^,SplitSize);

splitFn:=writeFn+format('.%3.3d',[cnt]);

fWriteHdl:=FileCreate(splitFn);

iffWriteHdl<1then

begin

result:=5;//'Can''tCreateFile';

exit;//somethingwrong!!

end;

try

FileWrite(fWriteHdl,Buffer^,ReadSize);

//settotheoriginalfile'sdatetime...

SetFileTime(fWriteHdl,nil,nil,@fModified);

finally

FileClose(fWriteHdl);

end;

inc(cnt);

ifEscapePressedthenexit;

until(ReadSize<>SplitSize);

//bottomofloop//////////////////////////////

finally

FileClose(fReadHdl);

end;

finally

FreeMem(Buffer);

end;

result:=0;

end;

//--------------------------------------------------------------------------

//CallfunctionSyntax

//vari:integer;

//begin

//i:=JoinFiles(ed_saveFile.Text,ed_FileList.Lines,ed_DeleteFile.Checked);

//caseiof

//0:StatusBar1.SimpleText:='JoinFinished';

//1:StatusBar1.SimpleText:='Can''tCreateFile';

//2:StatusBar1.SimpleText:='JoiningFiles';

//3:StatusBar1.SimpleText:='Can''tOpenFile';

//4:StatusBar1.SimpleText:='Can''tReadWriteFile';

//5:StatusBar1.SimpleText:='ChecksumFail';

//end;

functionJoinFiles(constsSaveFileName:string;sSplitFileName:TStrings;constbDeleteFile:Boolean):Integer;

var

cnt,FileSize,ReadSize,cntTotal:integer;

OldChecksum,NewChecksum:dword;

readFn,writeFn:string;

fReadHdl,fWriteHdl:THandle;

fModified:TFileTime;

buffer:pchar;

joinSize:integer;

begin

//getthefilenameforthenewfile...

writeFn:=sSaveFileName;

//createthenewfilereadyforwriting...

fWriteHdl:=FileCreate(writeFn);

iffWriteHdl<1then

begin

result:=1;//'Can''tCreateFile';

exit;//somethingwrong!!

end;

buffer:=nil;

try

cntTotal:=sSplitFileName.Count;

cnt:=0;

joinSize:=0;

result:=2;

//topofloop/////////////////////////////////

while(cnt<cntTotal)do

begin

//StatusBar1.SimpleText:='JoiningFilesCenceled'+IntToStr(cnt+1);

//geteachfilenamepartfromthelist...

readFn:=sSplitFileName[cnt];

ifreadFn=''thenbreak;

readFn:=readFn;

fReadHdl:=FileOpen(readFn,fmOpenReadorfmShareDenyNone);

iffReadHdl<1then

begin

result:=3;//'Can''tOpenFile';

exit;//somethingwrong!!

end;

//now,copythisfile...

try

//getthefirstfilepart'sdatetime...

ifcnt=0thenGetFileTime(fReadHdl,nil,nil,@fModified);

FileSize:=Windows.GetFileSize(fReadHdl,nil);

inc(joinSize,FileSize);

ReAllocMem(buffer,FileSize);

ifbuffer=nilthenbreak;

ReadSize:=FileRead(fReadHdl,Buffer^,FileSize);

ifReadSize<>FileSizethenbreak;

ifFileWrite(fWriteHdl,Buffer^,FileSize)<>FileSizethenbreak;

ifEscapePressedthenexit;

finally

FileClose(fReadHdl);

end;

inc(cnt);

end;

//bottomofloop//////////////////////////////

//checkforerrorswhilereading/writingfiles(see'breaks'above)...

ifdword(joinSize)<>Windows.GetFileSize(fWriteHdl,nil)then

begin

result:=4;//'Can''tReadWriteFile'

exit;//badcopy!!!

end;

//verifychecksumifpresent...

//(itwontbepresentifjoiningfilessplitbyanotherutility)

readFn:=changefileext(readFn,'.999');

iffileexists(readFn)then

begin

//result:=5;//'ChekcingChecksum';

NewChecksum:=GetChecksum(fWriteHdl);

ifnot(NewChecksum=$FFFFFFFF)then//usercancelledchecksumcalc

begin

fReadHdl:=FileOpen(readFn,fmOpenReadorfmShareDenyNone);

iffReadHdl>0then

try

ifFileRead(fReadHdl,OldChecksum,sizeof(OldChecksum))=

sizeof(OldChecksum)then

ifnot(NewChecksum=OldChecksum)then

begin

result:=5;//ChecksumFail

exit;//badchecksum!!!

end;

finally

FileClose(fReadHdl);

end;

//restorethefile'soriginalDateTime...

SetFileTime(fWriteHdl,nil,nil,@fModified);

finally

FileClose(fWriteHdl);

FreeMem(buffer);

end;

result:=0;

//deleteallfilepartsifcheckboxticked...

ifbDeleteFilethen

begin

//nb:readFnstill=Checksumfileatthispoint...

iffileexists(readFn)thenDeleteFile(readFn);

cnt:=0;

//topofloop/////////////////////////////////

whilecnt<cntTotaldo

begin

//geteachfilenameinthelist...

readFn:=sSplitFileName[cnt];

ifreadFn=''thenbreak;

DeleteFile(readFn);

inc(cnt);

end;

//bottomofloop//////////////////////////////

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;

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit2.Text := GetShortName(Edit1.Text);

end;

자기자신실행화일 삭제하기

procedure DeleteMe;

var

BatchFile: TextFile;

BatchFileName: string;

ProcessInfo: TProcessInformation;

StartUpInfo: TStartupInfo;

begin

{ create a batchfile in the applications directory }

BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat';

{ open and write the file }

AssignFile(BatchFile, BatchFileName);

Rewrite(BatchFile);

Writeln(BatchFile, ':try');

Writeln(BatchFile, 'del "' + ParamStr(0) + '"');

Writeln(BatchFile,

'if exist "' + ParamStr(0) + '"' + ' goto try');

Writeln(BatchFile, 'del "' + BatchFileName + '"');

CloseFile(BatchFile);

FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);

StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;

StartUpInfo.wShowWindow := SW_HIDE;

if CreateProcess(nil, PChar(BatchFileName), nil, nil,

False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,

ProcessInfo) then

begin

CloseHandle(ProcessInfo.hThread);

CloseHandle(ProcessInfo.hProcess);

end;

728x90

저작자표시

'Delphi > 프로시저-함수' 카테고리의 다른 글

델파이 유용한 함수정리 7탄 (0)	2021.07.08
델파이 유용한 함수정리 6탄 (0)	2021.07.07
델파이 유용한 함수정리 3탄 (0)	2021.07.02
델파이 문자열을 거꾸로 변환하는 함수 (0)	2021.07.01
델파이 BitBlt 함수 설명 (0)	2021.06.30

Mono IT

델파이 유용한 함수정리 5탄