Programlama yapalım ve Öğrenelim.

neoturk: ...Start a program and wait for its termination ?...

// With CreateProcess:

//*****************************************************

{1}

function WinExecAndWait32(FileName: string; Visibility: Integer): Longword;

var { by Pat Ritchey }

zAppName: array[0..512] of Char;

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

WorkDir: string;

StartupInfo: TStartupInfo;

ProcessInfo: TProcessInformation;

begin

StrPCopy(zAppName, FileName);

GetDir(0, WorkDir);

StrPCopy(zCurDir, WorkDir);

FillChar(StartupInfo, SizeOf(StartupInfo), #0);

StartupInfo.cb := SizeOf(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow := Visibility;

if not CreateProcess(nil,

zAppName, // pointer to command line string

nil, // pointer to process security attributes

nil, // pointer to thread security attributes

False, // handle inheritance flag

CREATE_NEW_CONSOLE or // creation flags

NORMAL_PRIORITY_CLASS,

nil, //pointer to new environment block

nil, // pointer to current directory name

StartupInfo, // pointer to STARTUPINFO

ProcessInfo) // pointer to PROCESS_INF

then Result := WAIT_FAILED

else

begin

WaitForSingleObject(ProcessInfo.hProcess, INFINITE);

GetExitCodeProcess(ProcessInfo.hProcess, Result);

CloseHandle(ProcessInfo.hProcess);

CloseHandle(ProcessInfo.hThread);

end;

end; { WinExecAndWait32 }

procedure TForm1.Button1Click(Sender: TObject);

begin

WinExecAndWait32('notepad.exe', False, True);

end;

{*******************************}

{2} "Anti-Freezing":

function ExecAndWait(const FileName: string; const CmdShow: Integer): Longword;

var { by Pat Ritchey }

zAppName: array[0..512] of Char;

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

WorkDir: string;

StartupInfo: TStartupInfo;

ProcessInfo: TProcessInformation;

AppIsRunning: DWORD;

begin

StrPCopy(zAppName, FileName);

GetDir(0, WorkDir);

StrPCopy(zCurDir, WorkDir);

FillChar(StartupInfo, SizeOf(StartupInfo), #0);

StartupInfo.cb := SizeOf(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow := CmdShow;

if not CreateProcess(nil,

zAppName, // pointer to command line string

nil, // pointer to process security attributes

nil, // pointer to thread security attributes

False, // handle inheritance flag

CREATE_NEW_CONSOLE or // creation flags

NORMAL_PRIORITY_CLASS,

nil, //pointer to new environment block

nil, // pointer to current directory name

StartupInfo, // pointer to STARTUPINFO

ProcessInfo) // pointer to PROCESS_INF

then Result := WAIT_FAILED

else

begin

while WaitForSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do

begin

Application.ProcessMessages;

Sleep(50);

end;

{

// or:

repeat

AppIsRunning := WaitForSingleObject(ProcessInfo.hProcess, 100);

Application.ProcessMessages;

Sleep(50);

until (AppIsRunning <> WAIT_TIMEOUT);

}

WaitForSingleObject(ProcessInfo.hProcess, INFINITE);

GetExitCodeProcess(ProcessInfo.hProcess, Result);

CloseHandle(ProcessInfo.hProcess);

CloseHandle(ProcessInfo.hThread);

end;

end; { WinExecAndWait32 }

procedure TForm1.Button1Click(Sender: TObject);

begin

ExecAndWait('C:ProgrammeWinZipWINZIP32.EXE', SW_SHOW);

end;

{3}

{--WinExecAndWait32V2 ------------------------------------------------}

{: Executes a program and waits for it to terminate

@Param FileName contains executable + any parameters

@Param Visibility is one of the ShowWindow options, e.g. SW_SHOWNORMAL

@Returns -1 in case of error, otherwise the programs exit code

@Desc In case of error SysErrorMessage( GetlastError ) will return an

error message. The routine will process paint messages and messages

send from other threads while it waits.

}{ Created 27.10.2000 by P. Below

-----------------------------------------------------------------------}

function WinExecAndWait32V2(FileName: string; Visibility: Integer): DWORD;

procedure WaitFor(processHandle: THandle);

var

Msg: TMsg;

ret: DWORD;

begin

repeat

ret := MsgWaitForMultipleObjects(1, { 1 handle to wait on }

processHandle, { the handle }

False, { wake on any event }

INFINITE, { wait without timeout }

QS_PAINT or { wake on paint messages }

QS_SENDMESSAGE { or messages from other threads }

);

if ret = WAIT_FAILED then Exit; { can do little here }

if ret = (WAIT_OBJECT_0 + 1) then

begin

{ Woke on a message, process paint messages only. Calling

PeekMessage gets messages send from other threads processed. }

while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do

DispatchMessage(Msg);

end;

until ret = WAIT_OBJECT_0;

end; { Waitfor }

var { V1 by Pat Ritchey, V2 by P.Below }

zAppName: array[0..512] of char;

StartupInfo: TStartupInfo;

ProcessInfo: TProcessInformation;

begin { WinExecAndWait32V2 }

StrPCopy(zAppName, FileName);

FillChar(StartupInfo, SizeOf(StartupInfo), #0);

StartupInfo.cb := SizeOf(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow := Visibility;

if not CreateProcess(nil,

zAppName, { pointer to command line string }

nil, { pointer to process security attributes }

nil, { pointer to thread security attributes }

False, { handle inheritance flag }

CREATE_NEW_CONSOLE or { creation flags }

NORMAL_PRIORITY_CLASS,

nil, { pointer to new environment block }

nil, { pointer to current directory name }

StartupInfo, { pointer to STARTUPINFO }

ProcessInfo) { pointer to PROCESS_INF } then

Result := DWORD(-1) { failed, GetLastError has error code }

else

begin

Waitfor(ProcessInfo.hProcess);

GetExitCodeProcess(ProcessInfo.hProcess, Result);

CloseHandle(ProcessInfo.hProcess);

CloseHandle(ProcessInfo.hThread);

end; { Else }

end; { WinExecAndWait32V2 }

procedure TForm1.Button1Click(Sender: TObject);

begin

WinExecAndWait32V2('notepad.exe', SW_SHOWNORMAL);

end;

// With ShellExecuteEx:

//*****************************************************

{1}

uses

ShellApi;

procedure ShellExecute_AndWait(FileName: string; Params: string);

var

exInfo: TShellExecuteInfo;

Ph: DWORD;

begin

FillChar(exInfo, SizeOf(exInfo), 0);

with exInfo do

begin

cbSize := SizeOf(exInfo);

fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;

Wnd := GetActiveWindow();

ExInfo.lpVerb := 'open';

ExInfo.lpParameters := PChar(Params);

lpFile := PChar(FileName);

nShow := SW_SHOWNORMAL;

end;

if ShellExecuteEx(@exInfo) then

Ph := exInfo.HProcess

else

begin

ShowMessage(SysErrorMessage(GetLastError));

Exit;

end;

while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do

Application.ProcessMessages;

CloseHandle(Ph);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShellExecute_AndWait('FileName', 'Parameter');

end;

{*******************************}

{2}

function ShellExecute_AndWait(Operation, FileName, Parameter, Directory: string;

Show: Word; bWait: Boolean): Longint;

var

bOK: Boolean;

Info: TShellExecuteInfo;

{

****** Parameters ******

Operation:

edit Launches an editor and opens the document for editing.

explore Explores the folder specified by lpFile.

find Initiates a search starting from the specified directory.

open Opens the file, folder specified by the lpFile parameter.

print Prints the document file specified by lpFile.

properties Displays the file or folder's properties.

FileName:

Specifies the name of the file or object on which

ShellExecuteEx will perform the action specified by the lpVerb parameter.

Parameter:

String that contains the application parameters.

The parameters must be separated by spaces.

Directory:

specifies the name of the working directory.

If this member is not specified, the current directory is used as the working directory.

Show:

Flags that specify how an application is to be shown when it is opened.

It can be one of the SW_ values

bWait:

If true, the function waits for the process to terminate

}

begin

FillChar(Info, SizeOf(Info), Chr(0));

Info.cbSize := SizeOf(Info);

Info.fMask := SEE_MASK_NOCLOSEPROCESS;

Info.lpVerb := PChar(Operation);

Info.lpFile := PChar(FileName);

Info.lpParameters := PChar(Parameter);

Info.lpDirectory := PChar(Directory);

Info.nShow := Show;

bOK := Boolean(ShellExecuteEx(@Info));

if bOK then

begin

if bWait then

begin

while

WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT

do Application.ProcessMessages;

bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));

end

else

Result := 0;

end;

if not bOK then Result := -1;

end;

Delphi - .....................................

neoturk: ...Reduce the application exe size ?...

Generally, EXE files created with Delphi are larger than EXE files

created with another programming language. The reason is the VCL.

(Sure, VCL has many advantages...)

There are several ways to reduce a EXE's size:

01) Use a EXE-Packer (UPX, ASPack,...)

02) Use KOL.

03) Write your application without VCL

04) Use the ACL (API Controls Library)

05) Use StripReloc.

06) Deactivate remote debugging information and TD32.

07) You might want to put code in a dll.

08) Don't put the same images several times on a form. Load them at runtime.

09) Use compressed images (JPG and not BMP)

10) Store less properties in DFM files

(See Link below "How To Make Your EXE's Lighter")

11) Use the TStringList replacement by ~LOM~

Use the Minireg - TRegistry replacement by Ben Hochstrasser

{*****************************************}

Mit Delphi erstellte Exe-Dateien sind im allgemeinen einiges grösser als solche,

welche mit anderen Programmiersprachen erzeugt wurden.

Der Grund dafür ist die VCL.

(Klar, Die VCL hat viele Vorteile...)

Es gibt verschiedene Möglichkeiten, um die Exe-Grösse zu reduzieren.

01) Einen EXE-Packer verwenden (UPX, ASPack, ....)

02) KOL verwenden.

03) Die Anwendung ohne VCL schreiben (nur mit API, nonVCL)

04) Die ACL (API Controls Library) verwenden.

05) StripReloc verwenden.

06) Debug Informationen und TD32 ausschalten.

07) Code in eine Dll auslagern.

08) Wenn Bilder mehrmals verwendet werden,

dann nur einmal einbinden und die anderen zur Laufzeit laden.

09) Bilder komprimieren (nicht bmp sondern z.B das jpg Format verwenden)

10) Weniger Properties in den DFM Dateien speichern

(Siehe Link unten ("How To Make Your EXE's Lighter")

11) Verwende den TStringList Ersatz von ~LOM~

Verwende die Minireg - TRegistry Ersatz von Ben Hochstrasser

{*****************************************}

// Further descriptions and links:

// Beschreibungen in Englisch und Links:

{****************************************************************}

01)

UPX is a free, portable, extendable, high-performance executable

packer for several different executable formats. It achieves an excellent

compression ratio and offers very fast decompression.

Your executables suffer no memory overhead or other drawbacks.

http://upx.sourceforge.net/

ASPack is an advanced Win32 executable file compressor, capable of reducing the file size of

32-bit Windows programs by as much as 70%. (ASPack's compression ratio improves upon the

industry-standard zip file format by as much as 10-20%.) ASPack makes Windows 95/98/NT

programs and libraries smaller, and decrease load times across networks, and download

times from the internet; it also protects programs against reverse engineering

by non-professional hackers.

Programs compressed with ASPack are self-contained and run exactly as before,

with no runtime performance penalties.

http://www.aspack.com/aspack.htm

{****************************************************************}

02)

KOL - Key Objects Library is a set of objects to develop power

(but small) 32 bit Windows GUI applications using Delphi but without VCL.

It is distributed free of charge, with source code.

http://bonanzas.rinet.ru/

{****************************************************************}

03)

nonVCL

Delphi lets you have it both ways. If you want tiny EXE's, then don't use

the VCL. Its entirely possible to use all the rich features of Delphi IDE

using 100% WinAPI calls, standard resources, etc.

http://nonvcl.luckie-online.de

http://www.erm.tu-cottbus.de/delphi/stuff/Tutorials/nonVCL/index.html

http://www.angelfire.com/hi5/delphizeus/

http://www.tutorials.delphi-source.de/nonvcl/

{****************************************************************}

04)

ACL (API Controls Library)

To write the program on pure API certainly it is possible, but I have deci-

ded to reach both goals - both to make that program and to receive the tool,

through which it would be possible in further to build similar programs, almost,

as on Delphi with VCL. So the idea to create my own TWinControl and all standard

Windows controls classes, derived from it has appeared.

http://www.apress.ru/pages/bokovikov/delphi/index.html/

{****************************************************************}

05)

StripReloc is a free (GPL license) command line utility that removes the relocation

(".reloc") section from Win32 PE EXE files, reducing their size.

Most compilers/linkers (including Delphi) put a relocation section in EXE files,

but this is actually not necessary since EXEs never get relocated.

Hence, a relocation section only wastes space.

Why not use an EXE compressor?

http://www.jrsoftware.org/striprlc.php

{****************************************************************}

06)

Deactivating the Debug Information

Exclude any debug information for the final build

(project-Options Compiler - Debugging and project-Options

Linker EXE and DLL options)

Dependeing on the amount of Debug information,

Debugging can take up until half of the size.

The options that are going to singificantly reduce your file size are

"Include TD32 debug info" and "Build with runtime packages". If you are

shipping commercial applications, you usually don't need the debug info

linked with your project.

{****************************************************************}

08/09)

About Images

The forms in your project have any bitmaps on them, then these are

compiled into the EXE. If you use the same bitmap multiple times, don't

assign them at design-time in the IDE as it will be included in the EXE

multiple times, assign them in code instead.

This can help reduce the size of the EXE, especially if you use large

bitmaps.

Use JPEG-files instead of BMP-files. This also reduces the EXE size.

{****************************************************************}

10)

How To Make Your EXE's Lighter:

http://www.undu.com/DN970301/00000064.htm

{****************************************************************}

11)

TStringList replacement by ~LOM~

Minireg - TRegistry replacement

Delphi - .....................................

neoturk: ...Reduce the application exe size ?...

Generally, EXE files created with Delphi are larger than EXE files

created with another programming language. The reason is the VCL.

(Sure, VCL has many advantages...)

There are several ways to reduce a EXE's size:

01) Use a EXE-Packer (UPX, ASPack,...)

02) Use KOL.

03) Write your application without VCL

04) Use the ACL (API Controls Library)

05) Use StripReloc.

06) Deactivate remote debugging information and TD32.

07) You might want to put code in a dll.

08) Don't put the same images several times on a form. Load them at runtime.

09) Use compressed images (JPG and not BMP)

10) Store less properties in DFM files

(See Link below "How To Make Your EXE's Lighter")

11) Use the TStringList replacement by ~LOM~

Use the Minireg - TRegistry replacement by Ben Hochstrasser

{*****************************************}

Mit Delphi erstellte Exe-Dateien sind im allgemeinen einiges grösser als solche,

welche mit anderen Programmiersprachen erzeugt wurden.

Der Grund dafür ist die VCL.

(Klar, Die VCL hat viele Vorteile...)

Es gibt verschiedene Möglichkeiten, um die Exe-Grösse zu reduzieren.

01) Einen EXE-Packer verwenden (UPX, ASPack, ....)

02) KOL verwenden.

03) Die Anwendung ohne VCL schreiben (nur mit API, nonVCL)

04) Die ACL (API Controls Library) verwenden.

05) StripReloc verwenden.

06) Debug Informationen und TD32 ausschalten.

07) Code in eine Dll auslagern.

08) Wenn Bilder mehrmals verwendet werden,

dann nur einmal einbinden und die anderen zur Laufzeit laden.

09) Bilder komprimieren (nicht bmp sondern z.B das jpg Format verwenden)

10) Weniger Properties in den DFM Dateien speichern

(Siehe Link unten ("How To Make Your EXE's Lighter")

11) Verwende den TStringList Ersatz von ~LOM~

Verwende die Minireg - TRegistry Ersatz von Ben Hochstrasser

{*****************************************}

// Further descriptions and links:

// Beschreibungen in Englisch und Links:

{****************************************************************}

01)

UPX is a free, portable, extendable, high-performance executable

packer for several different executable formats. It achieves an excellent

compression ratio and offers very fast decompression.

Your executables suffer no memory overhead or other drawbacks.

http://upx.sourceforge.net/

ASPack is an advanced Win32 executable file compressor, capable of reducing the file size of

32-bit Windows programs by as much as 70%. (ASPack's compression ratio improves upon the

industry-standard zip file format by as much as 10-20%.) ASPack makes Windows 95/98/NT

programs and libraries smaller, and decrease load times across networks, and download

times from the internet; it also protects programs against reverse engineering

by non-professional hackers.

Programs compressed with ASPack are self-contained and run exactly as before,

with no runtime performance penalties.

http://www.aspack.com/aspack.htm

{****************************************************************}

02)

KOL - Key Objects Library is a set of objects to develop power

(but small) 32 bit Windows GUI applications using Delphi but without VCL.

It is distributed free of charge, with source code.

http://bonanzas.rinet.ru/

{****************************************************************}

03)

nonVCL

Delphi lets you have it both ways. If you want tiny EXE's, then don't use

the VCL. Its entirely possible to use all the rich features of Delphi IDE

using 100% WinAPI calls, standard resources, etc.

http://nonvcl.luckie-online.de

http://www.erm.tu-cottbus.de/delphi/stuff/Tutorials/nonVCL/index.html

http://www.angelfire.com/hi5/delphizeus/

http://www.tutorials.delphi-source.de/nonvcl/

{****************************************************************}

04)

ACL (API Controls Library)

To write the program on pure API certainly it is possible, but I have deci-

ded to reach both goals - both to make that program and to receive the tool,

through which it would be possible in further to build similar programs, almost,

as on Delphi with VCL. So the idea to create my own TWinControl and all standard

Windows controls classes, derived from it has appeared.

http://www.apress.ru/pages/bokovikov/delphi/index.html/

{****************************************************************}

05)

StripReloc is a free (GPL license) command line utility that removes the relocation

(".reloc") section from Win32 PE EXE files, reducing their size.

Most compilers/linkers (including Delphi) put a relocation section in EXE files,

but this is actually not necessary since EXEs never get relocated.

Hence, a relocation section only wastes space.

Why not use an EXE compressor?

http://www.jrsoftware.org/striprlc.php

{****************************************************************}

06)

Deactivating the Debug Information

Exclude any debug information for the final build

(project-Options Compiler - Debugging and project-Options

Linker EXE and DLL options)

Dependeing on the amount of Debug information,

Debugging can take up until half of the size.

The options that are going to singificantly reduce your file size are

"Include TD32 debug info" and "Build with runtime packages". If you are

shipping commercial applications, you usually don't need the debug info

linked with your project.

{****************************************************************}

08/09)

About Images

The forms in your project have any bitmaps on them, then these are

compiled into the EXE. If you use the same bitmap multiple times, don't

assign them at design-time in the IDE as it will be included in the EXE

multiple times, assign them in code instead.

This can help reduce the size of the EXE, especially if you use large

bitmaps.

Use JPEG-files instead of BMP-files. This also reduces the EXE size.

{****************************************************************}

10)

How To Make Your EXE's Lighter:

http://www.undu.com/DN970301/00000064.htm

{****************************************************************}

11)

TStringList replacement by ~LOM~

Minireg - TRegistry replacement

Delphi - .....................................

neoturk: ...Get the windows file type ?...

uses

ShellAPI;

function MrsGetFileType(const strFilename: string): string;

var

FileInfo: TSHFileInfo;

begin

FillChar(FileInfo, SizeOf(FileInfo), #0);

SHGetFileInfo(PChar(strFilename), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);

Result := FileInfo.szTypeName;

end;

// Beispiel:

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage('File type is: ' + MrsGetFileType('c:autoexec.bat'));

end;

Delphi - .....................................

neoturk: ...Get the windows file type ?...

uses

ShellAPI;

function MrsGetFileType(const strFilename: string): string;

var

FileInfo: TSHFileInfo;

begin

FillChar(FileInfo, SizeOf(FileInfo), #0);

SHGetFileInfo(PChar(strFilename), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);

Result := FileInfo.szTypeName;

end;

// Beispiel:

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage('File type is: ' + MrsGetFileType('c:autoexec.bat'));

end;

Delphi - .....................................

neoturk: ...List all subdirectories of a directory ?...

procedure GetSubDirs(const sRootDir: string; slt: TStrings);

var

srSearch: TSearchRec;

sSearchPath: string;

sltSub: TStrings;

i: Integer;

begin

sltSub := TStringList.Create;

slt.BeginUpdate;

try

sSearchPath := AddDirSeparator(sRootDir);

if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then

repeat

if ((srSearch.Attr and faDirectory) = faDirectory) and

(srSearch.Name <> '.') and

(srSearch.Name <> '..') then

begin

slt.Add(sSearchPath + srSearch.Name);

sltSub.Add(sSearchPath + srSearch.Name);

end;

until (FindNext(srSearch) <> 0);

FindClose(srSearch);

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

GetSubDirs(sltSub.Strings[i], slt);

finally

slt.EndUpdate;

FreeAndNil(sltSub);

end;

Delphi - .....................................

neoturk: ...List all subdirectories of a directory ?...

procedure GetSubDirs(const sRootDir: string; slt: TStrings);

var

srSearch: TSearchRec;

sSearchPath: string;

sltSub: TStrings;

i: Integer;

begin

sltSub := TStringList.Create;

slt.BeginUpdate;

try

sSearchPath := AddDirSeparator(sRootDir);

if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then

repeat

if ((srSearch.Attr and faDirectory) = faDirectory) and

(srSearch.Name <> '.') and

(srSearch.Name <> '..') then

begin

slt.Add(sSearchPath + srSearch.Name);

sltSub.Add(sSearchPath + srSearch.Name);

end;

until (FindNext(srSearch) <> 0);

FindClose(srSearch);

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

GetSubDirs(sltSub.Strings[i], slt);

finally

slt.EndUpdate;

FreeAndNil(sltSub);

end;

Delphi - .....................................

neoturk: ...Split-merge files ?...

// Split file / File splitten

{

Parameters:

FileToSplit: Specify a file to split.

SizeofFiles: Specify the size of the files you want to split to (in bytes)

Progressbar: Specify a TProgressBar to show the splitting progress

Result:

SplitFile() will create files FileName.001, FileName.002, FileName.003 and so on

that are SizeofFiles bytes in size.

}

function SplitFile(FileName : TFileName; SizeofFiles : Integer; ProgressBar : TProgressBar) : Boolean;

var

i : Word;

fs, sStream: TFileStream;

SplitFileName: String;

begin

ProgressBar.Position := 0;

fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

try

for i := 1 to Trunc(fs.Size / SizeofFiles) + 1 do

begin

SplitFileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));

sStream := TFileStream.Create(SplitFileName, fmCreate or fmShareExclusive);

try

if fs.Size - fs.Position < SizeofFiles then

SizeofFiles := fs.Size - fs.Position;

sStream.CopyFrom(fs, SizeofFiles);

ProgressBar.Position := Round((fs.Position / fs.Size) * 100);

finally

sStream.Free;

end;

finally

fs.Free;

end;

// Combine files / Dateien zusammenführen

{

Parameters:

FileName: Specify the first piece of the splitted files

CombinedFileName: Specify the combined file name. (the output file)

Result:

CombineFiles() will create one large file from the pieces

}

function CombineFiles(FileName, CombinedFileName : TFileName) : Boolean;

var

i: integer;

fs, sStream: TFileStream;

filenameOrg: String;

begin

i := 1;

fs := TFileStream.Create(CombinedFileName, fmCreate or fmShareExclusive);

try

while FileExists(FileName) do

begin

sStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

try

fs.CopyFrom(sStream, 0);

finally

sStream.Free;

end;

Inc(i);

FileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));

end;

finally

fs.Free;

end;

// Examples:

procedure TForm1.Button1Click(Sender: TObject);

begin

SplitFile('C:tempFileToSplit.chm',1000000, ProgressBar1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

CombineFiles('C:tempFileToSplit.001','H:tempFileToSplit.chm');

end;

Delphi - .....................................

neoturk: ...Split-merge files ?...

// Split file / File splitten

{

Parameters:

FileToSplit: Specify a file to split.

SizeofFiles: Specify the size of the files you want to split to (in bytes)

Progressbar: Specify a TProgressBar to show the splitting progress

Result:

SplitFile() will create files FileName.001, FileName.002, FileName.003 and so on

that are SizeofFiles bytes in size.

}

function SplitFile(FileName : TFileName; SizeofFiles : Integer; ProgressBar : TProgressBar) : Boolean;

var

i : Word;

fs, sStream: TFileStream;

SplitFileName: String;

begin

ProgressBar.Position := 0;

fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

try

for i := 1 to Trunc(fs.Size / SizeofFiles) + 1 do

begin

SplitFileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));

sStream := TFileStream.Create(SplitFileName, fmCreate or fmShareExclusive);

try

if fs.Size - fs.Position < SizeofFiles then

SizeofFiles := fs.Size - fs.Position;

sStream.CopyFrom(fs, SizeofFiles);

ProgressBar.Position := Round((fs.Position / fs.Size) * 100);

finally

sStream.Free;

end;

finally

fs.Free;

end;

// Combine files / Dateien zusammenführen

{

Parameters:

FileName: Specify the first piece of the splitted files

CombinedFileName: Specify the combined file name. (the output file)

Result:

CombineFiles() will create one large file from the pieces

}

function CombineFiles(FileName, CombinedFileName : TFileName) : Boolean;

var

i: integer;

fs, sStream: TFileStream;

filenameOrg: String;

begin

i := 1;

fs := TFileStream.Create(CombinedFileName, fmCreate or fmShareExclusive);

try

while FileExists(FileName) do

begin

sStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

try

fs.CopyFrom(sStream, 0);

finally

sStream.Free;

end;

Inc(i);

FileName := ChangeFileExt(FileName, '.'+ FormatFloat('000', i));

end;

finally

fs.Free;

end;

// Examples:

procedure TForm1.Button1Click(Sender: TObject);

begin

SplitFile('C:tempFileToSplit.chm',1000000, ProgressBar1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

CombineFiles('C:tempFileToSplit.001','H:tempFileToSplit.chm');

end;

Delphi - .....................................

neoturk: ...Get a mp3's id3-tag ?...

{

Byte 1-3 = ID 'TAG'

Byte 4-33 = Titel / Title

Byte 34-63 = Artist

Byte 64-93 = Album

Byte 94-97 = Jahr / Year

Byte 98-127 = Kommentar / Comment

Byte 128 = Genre

}

type

TID3Tag = record

ID: string[3];

Titel: string[30];

Artist: string[30];

Album: string[30];

Year: string[4];

Comment: string[30];

Genre: Byte;

end;

const

Genres : array[0..146] of string =

('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge',

'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B',

'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska',

'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',

'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',

'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',

'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',

'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',

'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',

'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',

'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',

'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',

'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',

'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',

'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',

'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',

'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',

'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',

'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',

'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',

'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',

'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',

'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');

var

Form1: TForm1;

implementation

{$R *.dfm}

function readID3Tag(FileName: string): TID3Tag;

var

FS: TFileStream;

Buffer: array [1..128] of Char;

begin

FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

try

FS.Seek(-128, soFromEnd);

FS.Read(Buffer, 128);

with Result do

begin

ID := Copy(Buffer, 1, 3);

Titel := Copy(Buffer, 4, 30);

Artist := Copy(Buffer, 34, 30);

Album := Copy(Buffer, 64, 30);

Year := Copy(Buffer, 94, 4);

Comment := Copy(Buffer, 98, 30);

Genre := Ord(Buffer[128]);

end;

finally

FS.Free;

end;

procedure TfrmMain.Button1Click(Sender: TObject);

begin

if OpenDialog1.Execute then

begin

with readID3Tag(OpenDialog1.FileName) do

begin

LlbID.Caption := 'ID: ' + ID;

LlbTitel.Caption := 'Titel: ' + Titel;

LlbArtist.Caption := 'Artist: ' + Artist;

LlbAlbum.Caption := 'Album: ' + Album;

LlbYear.Caption := 'Year: ' + Year;

LlbComment.Caption := 'Comment: ' + Comment;

if (Genre >= 0) and (Genre <=146) then

LlbGenre.Caption := 'Genre: ' + Genres[Genre]

else

LlbGenre.Caption := 'N/A';