전체경로 폴더생성 function ForceDirectories(Dir: string): Boolean; or 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;
end;
finally
sList.Free;
end;
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;
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;
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;
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;
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;
end; 파일복사 procedure FileCopy( const SrcFile, TarFile: string );
begin
try
CopyFile(PChar(SrcFile),PChar(TarFile),false);
except
end;
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...
//(http://www.efg2.com/Lab/Mathematics/CRC.htm)
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;
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;
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;
end;
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;
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;
end; 외부 프로그램 위치 이동하기 procedure TFrm_wiseFNUpdateMain.Fnwindowpos;
var WinPlac: TWindowPlacement;
iRight, iBottom: Integer;
begin
H:= FindWindow('TfrmValuewise',nil);
if (H > 0) and IsWindowVisible(H) then
begin
FillChar(WinPlac, SizeOf(WinPlac), 0);
WinPlac.length := SizeOf(WinPlac);
GetWindowPlacement(H, @WinPlac);
// 윈도우즈가 표준상태일때의 좌표를 구한다
iRight := WinPlac.rcNormalPosition.Right - WinPlac.rcNormalPosition.Left;
iBottom:= WinPlac.rcNormalPosition.Bottom - WinPlac.rcNormalPosition.Top;
WinPlac.rcNormalPosition.Left:= 0;
WinPlac.rcNormalPosition.Top := 0;
WinPlac.rcNormalPosition.Right := iRight;
WinPlac.rcNormalPosition.Bottom:= iBottom;
SetWindowPlacement(H, @WinPlac);
end;
Memo1.Lines.Add('프로그램 위치조정');
end; 실행화일에서 아이콘 가지고 오기 var hinstance: HINST;
begin
image1.Picture.Icon.handle := ExtractIcon(hinstance, 'notepad.exe', 0);
end; 실행화일에 PATH알기 ShowMessage(ExtractFilePath(Application.ExeName)); 실행시 화일이름변경 ReNameFile(Application.ExeName, ExtractFilePath(Application.ExeName) + '라라라.exe'); 바탕화면에 그림설정하기 var
s: string;
begin
if OpenDialog1.Execute then
s := OpenDialog1.FileName;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s), 0) ProgressBar사용 화일복사 procedure FileCopy(fn1, fn2: string; Bar: TProgressBar);
var
iBuffer,iCount: LongInt;
F,TF: Integer;
iFileLength: Int64;
iCnt: Int64;
begin
iBuffer:= 0; iCount:= 1;
F:= FileOpen(PChar(Fn1),fmOpenRead);
TF:= FileCreate(Fn2);
try
iFileLength := FileSeek(F,Int64(0),2);
Bar.Max:= iFileLength;
FileSeek(F,0,0);
iCnt:= 0;
while iFileLength > iCnt do begin
FileRead(F, iBuffer, iCount);
FileWrite(TF,iBuffer,iCount);
Bar.Position:= iCnt;
iCnt:= FileSeek(F,Int64(0),1);
end;
finally
FileClose(F);
FileClose(TF);
end;
end; 자기 자신을 지우는 프로그램 만들기
from. 나이렉스 홈페이지 팁란( <a href='http://www.nilex.net/ target='_blank'>http://www.nilex.net/</a> )
안치봉( <a href='mailto:ahn@nilex.co.kr' target='_blank'>ahn@nilex.co.kr</a> )
자기 자신을 지우는 프로그램은 대부분 인스톨에 관계된것 중에서 Uninstall 프로그램
에 적용이 됩니다. 아래는 그 소스입니다. 간단히 설명을 드리자면 원래 실행중인 프
로그램을 당장(?) 삭제하는것은 힘듭니다. 그래서 아래꽁수는 시스템에서 지원해주는
기능을 사용합니다. 자세한건 소스를 직접 분석해 보시기 바랍니다 - 백문이 불여 일
행!
...
...
procedure TForm1.RemoveFile(FileName: String);
var
ShortDest: array[0..400] of Char;
WINInit: TINIFile;
begin
case GetWindowsVerType of
wvWin95: begin
WINInit := TINIFile.Create('WININIT.INI');
try
GetShortPathName(PChar(FileName),ShortDest,SizeOf(ShortDest));
WINInit.WriteString('Rename','nul',StrPas(ShortDest));
finally
WINInit.Free;
end;
end;
else
MoveFileEx(PChar(FileName),Nil,MOVEFILE_REPLACE_EXISTING or MOVEFILE_DELAY_U
NTIL_REBOOT);
end;
end;
function TForm1.GetWindowsVerType: TWindowsVerType;
var
OSVersionInfo: TOSVersionInfo;
Version: String;
begin
Result := wvUnidentified;
OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if not GetVersionEx(OSVersionInfo) then
raise Exception.Create('Could not get information about the current version
of Windows');
Version := IntToStr(OSVersionInfo.dwMajorVersion)+'.'+IntToStr(OSVersionInfo.d
wMinorVersion);
case OSVersionInfo.dwPlatformId of
VER_PLATFORM_WIN32s: Result := wv31Win32;
VER_PLATFORM_WIN32_WINDOWS: Result := wvWin95;
VER_PLATFORM_WIN32_NT: begin
if Pos('3.5',Version) > 0 then
Result := wvWinNT351
else
Result := wvWinNT;
end;
else
Result := wvUnidentified;
end;
end; |
댓글 1개:
Are you trying to make cash from your visitors by using popup advertisments?
In case you are, did you try using EroAdvertising?
댓글 쓰기