Programlama yapalım ve Öğrenelim.

System Genel Bilgilendirme

Contributor: SWAG SUPPORT TEAM

unit Disques;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

FileCtrl,LZExpand,ShellAPI;

// Constants

const

(* drive type *)

_drive_not_exist = 255;

_drive_floppy = 1;

_drive_hard = 2;

_drive_network = 3;

_drive_CDRom = 4;

_drive_RAM = 5;

(* directory option *)

_directory_recurrent = 1;

_directory_not_recurrent = 0;

_directory_force = 1;

_directory_not_force = 0;

_directory_clear_file = 1;

_directory_not_clear_file = 0;

(* file error *)

_File_Unable_To_Delete = 10;

_File_Copied_Ok = 0;

_File_Already_Exists = 1;

_File_Bad_Source = 2;

_File_Bad_Destination = 3;

_File_Bad_Source_Read = 4;

_File_Bad_Destination_Read = 5;

(* copy switch *)

_File_copy_Overwrite = 1;

// Drives

function _Drive_Type (_Drive : char) : byte;

function _Drive_As_Disk (_Drive: Char): Boolean;

function _Drive_Size (_Drive : char) : longint;

function _Drive_Free (_Drive : char) : longint;

// Directories

function _Directory_Exist (_Dir : string) : boolean;

function _Directory_Create (_Dir : string) : boolean;

function _Directory_Delete (_Dir : string;ClearFile : byte) : boolean;

function _Directory_Delete_Tree (_Dir : string; ClearFile : byte) : boolean;

function _Directory_Rename (_Dir,_NewDir : string) : boolean;

// Files

function _File_Exist (_File : string) : boolean;

function _File_Delete (_File : string) : boolean;

function _File_Recycle (_File : string) : boolean;

function _File_Rename (_File,_NewFile : string;_Delete : byte) : boolean;

function _File_Copy_UnCompress (FromFile,ToFile : string;Switch : byte) : byte;

function _File_Copy(source,dest: String): Boolean;

function _File_Move (_Source,_Destination : string) : boolean;

function _File_Get_Attrib (_File : string) : byte;

function _File_Set_Attrib (_File : string;_Attrib : byte) : boolean;

function _File_Get_Date (_File : string) : string;

function _File_Set_Date (_File,_Date : string) : boolean;

function _File_Get_Size (_File : string) : longint;

function _File_Start (AppName,AppParams,AppDir : string) : integer;

// Miscellaneous

function _Get_WindowsDir : string;

function _Get_SystemDir : string;

function _Get_TempDir : string;

function _Get_Apps_Dir (ExeName : PChar) : string;

function _Get_Apps_Drive (ExeName : PChar) : string;

function _Get_WindowsVer : real;

function _Get_WindowsBuild : real;

function _Get_WindowsPlatform : string;

function _Get_WindowsExtra : string;

implementation

(**********)

(* drives *)

(**********)

(* type of drive *)

function _Drive_Type (_Drive : char) : byte;

var i: integer;

c : array [0..255] of char;

begin

_Drive := upcase (_Drive);

if not (_Drive in ['A'..'Z']) then

Result := _drive_not_exist

else

begin

strPCopy (c,_Drive + ':');

i := GetDriveType (c);

case i of

DRIVE_REMOVABLE: result := _drive_floppy;

DRIVE_FIXED : result := _drive_hard;

DRIVE_REMOTE : result := _drive_network;

DRIVE_CDROM : result := _drive_CDRom;

DRIVE_RAMDISK : result := _drive_RAM;

else

result := _drive_not_exist;

end;

(* test is a disk is in drive *)

function _Drive_As_Disk (_Drive: Char): Boolean;

var ErrorMode: Word;

begin

_Drive := UpCase(_Drive);

if not (_Drive in ['A'..'Z']) then

raise

EConvertError.Create ('Not a valid drive letter');

ErrorMode := SetErrorMode (SEM_FailCriticalErrors);

try

Application.ProcessMessages;

Result := (DiskSize ( Ord(_Drive) - Ord ('A') + 1) <> -1);

finally

SetErrorMode(ErrorMode);

Application.ProcessMessages;

end;

(* size of drive *)

function _Drive_Size (_Drive : char) : longint;

var ErrorMode : word;

begin

_Drive := upcase (_Drive);

if not (_Drive in ['A'..'Z']) then

raise

EConvertError.Create ('Not a valid drive letter');

ErrorMode := SetErrorMode (SEM_FailCriticalErrors);

try

Application.ProcessMessages;

Result := DiskSize ( Ord(_Drive) - Ord ('A') + 1);

finally

SetErrorMode (ErrorMode);

end;

(* free space in drive *)

function _Drive_Free (_Drive : char) : longint;

var ErrorMode : word;

begin

_Drive := upcase (_Drive);

if not (_Drive in ['A'..'Z']) then

raise

EConvertError.Create ('Not a valid drive letter');

ErrorMode := SetErrorMode (SEM_FailCriticalErrors);

try

Application.ProcessMessages;

Result := DiskFree ( Ord(_Drive) - Ord ('A') + 1);

finally

SetErrorMode (ErrorMode);

end;

(***************)

(* directories *)

(***************)

(* directory exists or not *)

function _Directory_Exist (_Dir : string) : boolean;

VAR OldMode : Word;

OldDir : String;

BEGIN

Result := True;

GetDir(0, OldDir);

OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

ChDir(_Dir);

except

ON EInOutError DO

Result := False;

end;

finally

ChDir(OldDir);

SetErrorMode(OldMode);

end;

END;

(* create a directory enven if parent does not exists *)

function _Directory_Create (_Dir : string) : boolean;

begin

ForceDirectories(_Dir);

Result := _Directory_Exist (_Dir);

end;

(* delete a directory *)

function _Directory_Delete (_Dir : string;ClearFile : byte) : boolean;

begin

if _Directory_Exist (_Dir) then

Result := RemoveDir (_Dir)

else

Result := false;

end;

(* delete a tree *)

function _directory_delete_tree (_Dir : string; ClearFile : byte) : boolean;

var SearchRec : TSearchRec;

Erc : Word;

begin

if _Directory_Exist (_Dir) then

begin

Try

ChDir (_Dir);

FindFirst('*.*',faAnyFile,SearchRec);

Erc := 0;

while Erc = 0 do

begin

if ((SearchRec.Name <> '.' ) and

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

begin

if (SearchRec.Attr and faDirectory > 0) then

_Directory_Delete_Tree (SearchRec.Name,ClearFile)

else

if ClearFile = 1 then

_File_Delete (SearchRec.Name);

end;

Erc := FindNext (SearchRec);

end;

FindClose (SearchRec);

Application.ProcessMessages;

finally

if Length(_Dir) > 3 then

ChDir ('..' );

Result := RemoveDir (_Dir);

end;

end

else

(* not exists *)

Result := false;

end;

(* Renamme a directory *)

function _Directory_Rename (_Dir,_NewDir : string) : boolean;

var SearchRec : TSearchRec;

Erc : Word;

f : file;

o : string;

begin

if _Directory_Exist (_Dir) then

begin

Try

(* just name of directory *)

o := _dir;

Delete (o,1,2); (* remove drive and : *)

if o [1] = '' then delete (o,1,1); (* remove at begin *)

if o [length (o)] = '' then

o := copy (o,1,length (o)-1); (* delete at end *)

ChDir (_Dir);

ChDir ('..');

FindFirst('*.*',faAnyFile,SearchRec);

Erc := 0;

while Erc = 0 do

begin

if ((SearchRec.Name <> '.' ) and

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

begin

if (SearchRec.Attr and faDirectory > 0) then

begin

if SearchRec.Name = o then

begin

assignfile (f,SearchRec.Name);

{$I-};

rename (F,_NewDir);

{I+};

result := (ioresult = 0);

end;

Erc := FindNext (SearchRec);

end;

Application.ProcessMessages;

finally

if Length(_Dir) > 3 then

ChDir ('..' );

end;

FindClose (SearchRec);

end

else

(* not exists *)

Result := false;

end;

(*********)

(* files *)

(*********)

(* file exists or not *)

function _File_Exist (_File : string) : boolean;

begin

_File_Exist := FileExists(_File);

end;

(* delete a file remove -r if needed *)

function _File_Delete (_File : string) : boolean;

begin

if FileExists (_File) then

begin

_File_Set_Attrib (_File,0);

Result := DeleteFile (_File);

end

else

Result := false;

end;

(* send a file to recycle *)

function _File_Recycle(_File : TFilename): boolean;

var Struct: TSHFileOpStruct;

pFromc: array[0..255] of char;

Resul : integer;

begin

if not FileExists(_File) then

begin

_File_Recycle := False;

exit;

end

else

begin

fillchar(pfromc,sizeof(pfromc),0);

StrPcopy(pfromc,expandfilename(_File)+#0#0);

Struct.wnd := 0;

Struct.wFunc := FO_DELETE;

Struct.pFrom := pFromC;

Struct.pTo := nil;

Struct.fFlags:= FOF_ALLOWUNDO or FOF_NOCONFIRMATION ;

Struct.fAnyOperationsAborted := false;

Struct.hNameMappings := nil;

Resul := ShFileOperation(Struct);

_File_Recycle := (Resul = 0);

end;

(* renamme a file, delete if needed *)

function _File_Rename (_File,_NewFile : string;_Delete : byte) : boolean;

var f : file;

begin

if FileExists (_File) then

begin

if FileExists (_NewFile) then

begin

if _Delete = 0 then

Result := false

else

_File_Delete (_NewFile);

end;

assignfile (f,_File);

{$I-};

Rename (f,_NewFile);

{$I+};

Result := (ioresult = 0);

end

else

Result := false;

end;

(* copy a file *)

function _File_Copy_UnCompress (FromFile,ToFile : string;Switch : byte) : byte;

var Tmp : integer;

FromF, ToF: file;

NumRead, NumWritten: Word;

iHandle : Integer;

iNewHandle : Integer;

iReturn : Integer;

iLongReturn : LongInt;

pFrom : Array[0..256] of Char;

pTo : Array[0..256] of Char;

begin

Tmp := 0;

If (FileExists (ToFile)) and (Switch = 0) then

Tmp := 1

else

begin

StrPCopy( pFrom, FromFile );

iReturn := GetExpandedName( pFrom, pTo );

if iReturn = -1 then

Tmp := 2

else

begin

if iReturn = -2 then

Tmp := 3

else

begin

if ( StrEnd( pTo ) - pTo ) > 0 then

begin

ToFile := ExtractFilePath( ToFile ) +

ExtractFileName( strPas( pTo ) );

iHandle := FileOpen( FromFile, fmShareDenyWrite );

LZInit (iHandle);

if iHandle < 1 then

Tmp := 2

else

begin

iNewHandle := FileCreate( ToFile );

if iNewHandle < 1 then

Tmp := 3

else

begin

iLongReturn := LZCopy( iHandle , iNewHandle );

if iLongReturn = LZERROR_UNKNOWNALG then

Tmp := 5

else

begin

FileClose( iHandle );

FileClose( iNewHandle );

LZClose (iHandle);

end;

end

else

Tmp := 3;

end

end;

_File_Copy_UnCompress := Tmp;

end;

(* just copy a file *)

function _File_Copy(source,dest: String): Boolean;

var

fSrc,fDst,len: Integer;

size: Longint;

buffer: packed array [0..2047] of Byte;

begin

if pos ('',source) <> 0 then delete (source,pos ('',source),1);

if pos ('',dest) <> 0 then delete (dest,pos ('',dest),1);

Result := False;

if source <> dest then

begin

fSrc := FileOpen(source,fmOpenRead);

if fSrc >= 0 then

begin

size := FileSeek(fSrc,0,2);

FileSeek(fSrc,0,0);

fDst := FileCreate(dest);

if fDst >= 0 then begin

while size > 0 do

begin

len := FileRead(fSrc,buffer,sizeof(buffer));

FileWrite(fDst,buffer,len);

size := size - len;

end;

FileSetDate(fDst,FileGetDate(fSrc));

FileClose(fDst);

FileSetAttr(dest,FileGetAttr(source));

Result := True;

end;

FileClose(fSrc);

end;

(* move a file *)

function _File_Move (_Source,_Destination : string) : boolean;

var Tmp : boolean;

begin

tmp := _File_Copy (_Source,_Destination);

if Tmp = true then

if _File_Delete (_Source) = true then

Tmp := true

else

Tmp := false;

Result := Tmp;

end;

(* Get file attributes *)

function _File_Get_Attrib (_File : string) : byte;

var Tmp : byte;

Att : integer;

begin

if FileExists (_File) then

begin

Att := FileGetAttr (_File);

if Att <> -1 then

begin

Tmp := 0;

if (Att AND faReadOnly) = faReadOnly then Tmp := Tmp + 1;

if (Att AND faHidden) = faHidden then Tmp := Tmp + 2;

if (Att AND faSysFile) = faSysFile then Tmp := Tmp + 4;

if (Att AND faArchive) = faArchive then Tmp := Tmp + 8;

Result := Tmp;

end

else

Result := 255;

end

else

Result := 255;

end;

(* Set file attributes *)

function _File_Set_Attrib (_File : string;_Attrib : byte) : boolean;

var Tmp : integer;

begin

if FileExists (_File) then

begin

Tmp := 0;

if _Attrib and 1 = 1 then Tmp := tmp OR faReadOnly;

if _Attrib and 2 = 2 then Tmp := tmp OR faHidden;

if _Attrib and 4 = 4 then Tmp := tmp OR faSysFile;

if _Attrib and 8 = 8 then Tmp := tmp OR faArchive;

Result := FileSetAttr (_File,Tmp) = 0;

end

else

Result := false

end;

(* Get datestamp of file *)

function _File_Get_Date (_File : string) : string;

var f : file;

Hdl : integer;

Tmp : string;

Dte : integer;

Dat : TDateTime;

begin

Tmp := '';

Hdl := FileOpen(_File, fmOpenRead or fmShareDenyNone);

if Hdl > 0 then

begin

Dte := FileGetDate (Hdl);

FileClose (Hdl);

Dat := FileDateToDateTime (Dte);

Tmp := DateToStr (Dat);

while pos ('/',Tmp) <> 0 do delete (Tmp,pos ('/',Tmp),1);

if length (tmp) > 6 then delete (Tmp,5,2);

end;

Result := Tmp;

end;

(* Set datestamp of file *)

function _File_Set_Date (_File,_Date : string) : boolean;

var f : file;

Hdl : integer;

Dte : integer;

Dat : TDateTime;

Att : integer;

begin

Att := _File_Get_Attrib (_File);

if (Att AND 1) <> 1 then Att := 0

else _File_Set_Attrib (_File,0);

Hdl := FileOpen(_File, fmOpenReadWrite or fmShareDenyNone);

if Hdl > 0 then

begin

if length (_Date) < 8 then Insert ('19',_Date,5);

if pos ('/',_Date) = 0 then

_Date := copy (_Date,1,2) + '/' +

copy (_Date,3,2) + '/' +

copy (_Date,5,4);

Dat := StrToDateTime (_Date);

Dte := DateTimeToFileDate (Dat);

Result := FileSetDate (Hdl,Dte) = 0;

FileClose (Hdl);

if Att <> 0 then

_File_Set_Attrib (_File,Att);

end

else

begin

if Att <> 0 then

_File_Set_Attrib (_File,Att);

Result := False;

end;

(* return size of a file *)

function _File_Get_Size (_File : string) : longint;

var f: file of Byte;

a : integer;

begin

if FileExists (_File) then

begin

a := _File_Get_Attrib (_File);

if (a AND 1) = 1 then

_File_Set_Attrib (_File,0)

else

a := 0;

AssignFile(f,_File);

{$I-};

Reset(f);

{$I+};

if ioresult = 0 then

begin

Result := FileSize(f);

CloseFile(f);

if a <> 0 then

_File_Set_Attrib (_File,a);

end

else

begin

if a <> 0 then

_File_Set_Attrib (_File,a);

Result := -1;

end;

end

else

Result := -1;

end;

(* lancement d'une application *)

function _File_Start (AppName,AppParams,AppDir : string) : integer;

var Tmp : Integer;

zFileName : array [0 .. 79] of char;

zParams : array [0 .. 79] of char;

zDir : array [0 .. 79] of Char;

begin

Tmp := 0;

StrPCopy (zFileName,AppName);

StrPCopy (zParams,AppParams);

StrPCopy (zDir,AppDir);

Tmp := ShellExecute (0,Nil,zFileName,zParams,zDir,1);

_File_Start := Tmp;

end;

(*****************)

(* miscellaneous *)

(*****************)

(* return Windows directory *)

function _Get_WindowsDir : string;

var Tmp : array [0 .. 255] of char;

Ret : string;

begin

if GetWindowsDirectory (Tmp,255) <> 0 then

begin

Ret := StrPas (Tmp);

if Ret [length (Ret)] = '' then

Ret := copy (Ret,1,length (Ret) - 1);

Result := Ret;

end

else

Result := '';

end;

(* return Windows system directory *)

function _Get_SystemDir : string;

var Tmp : array [0 .. 255] of char;

Ret : string;

begin

if GetSystemDirectory (Tmp,255) <> 0 then

begin

Ret := StrPas (Tmp);

if Ret [length (Ret)] = '' then

Ret := copy (Ret,1,length (Ret) - 1);

Result := Ret;

end

else

Result := '';

end;

(* return Windows Temp directory *)

function _Get_TempDir : string;

var Tmp : array [0 .. 255] of char;

Ret : string;

begin

if GetTempPath (255,Tmp) <> 0 then

begin

Ret := StrPas (Tmp);

if Ret [length (Ret)] = '' then

Ret := copy (Ret,1,length (Ret) - 1);

Result := Ret;

end

else

Result := '';

end;

(* return application directory *)

function _Get_Apps_Dir (ExeName : PChar) : string;

var Hdl : THandle;

Nam : PChar;

Fil : array [0..255] of char;

Siz : integer;

Ret : integer;

Pas : string;

Pat : string [79];

begin

Pat := '';

Hdl := GetModuleHandle (ExeName);

Ret := GetModuleFileName (Hdl,Fil,Siz);

Pas := StrPas (Fil);

Pat := ExtractFilePath (Pas);

Delete (Pat,1,2);

if Pat [length (Pat)] = '' then

Pat := copy (Pat,1,length (Pat) - 1);

Result := Pat;

end;

(* return dirve of current application *)

function _Get_Apps_Drive (ExeName : PChar) : string;

var Hdl : THandle;

Nam : PChar;

Fil : array [0..255] of char;

Siz : integer;

Ret : integer;

Pas : string;

Drv : string [02];

begin

Drv := '';

Hdl := GetModuleHandle (ExeName);

Ret := GetModuleFileName (Hdl,Fil,Siz);

Pas := StrPas (Fil);

Drv := ExtractFilePath (Pas);

_Get_Apps_Drive := Drv;

end;

(* return windows version as a real *)

function _Get_WindowsVer : real;

var tempo : string;

Temp : real;

err : integer;

struct : TOSVersionInfo;

begin

struct.dwOSVersionInfoSize := sizeof (Struct);

struct.dwMajorVersion := 0;

struct.dwMinorVersion := 0;

GetVersionEx (Struct);

Tempo := inttostr (Struct.dwMajorVersion) + '.' + inttostr (Struct.dwMinorVersion);

val (tempo,temp,err);

Result := Temp;

end;

(* return type of platform *)

function _Get_WindowsPlatform : string;

var tempo : string;

Temp : string;

err : integer;

struct : TOSVersionInfo;

begin

struct.dwOSVersionInfoSize := sizeof (Struct);

struct.dwPlatformId := 0;

GetVersionEx (Struct);

case struct.dwPlatformid of

ver_platform_win32s : temp := 'Win32S';

ver_platform_win32_windows : temp := 'Win32';

ver_platform_win32_nt : temp := 'WinNT';

end;

Result := Temp;

end;

(* get extra information *)

function _Get_WindowsExtra : string;

var tempo : string;

Temp : string;

err : integer;

struct : TOSVersionInfo;

begin

struct.dwOSVersionInfoSize := sizeof (Struct);

struct.dwMajorVersion := 0;

struct.dwMinorVersion := 0;

struct.dwBuildNumber := 0;

struct.dwPlatformId := 0;

GetVersionEx (Struct);

Temp := '';

Temp := strPas (Struct.szCSDVersion);

Result := Temp;

end;

(* return windows build as a real *)

function _Get_WindowsBuild : real;

var tempo : string;

Temp : real;

err : integer;

struct : TOSVersionInfo;

begin

struct.dwOSVersionInfoSize := sizeof (Struct);

struct.dwBuildNumber := 0;

GetVersionEx (Struct);

tempo := inttostr (struct.dwBuildNumber AND $0000FFFF);

val (tempo,temp,err);

Result := Temp;

end;

begin

end.

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

rasgele sifre

function RandomPassword(PLen:Integer):String;

var

str:String;

begin

Randomize;

str:='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';

Result:='';

repeat

Result:=Result+str[Random(Length(str))+1];

until(Length(Result)=PLen)

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption:=RandomPassword(10);

end;

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

rasgele sifre

function RandomPassword(PLen:Integer):String;

var

str:String;

begin

Randomize;

str:='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';

Result:='';

repeat

Result:=Result+str[Random(Length(str))+1];

until(Length(Result)=PLen)

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption:=RandomPassword(10);

end;
end.

** VURGU-3 ** [ TAVSİYELER ]

- bir dili çok iyi öğrenin, çok çok daha ötesini öğrenin, dibine kadar vurun.

(örneğin benim en iyi bildiğim ve dibine kadar vurduğum 3 dil var)

( 1. quick basic 2. delphi 3. C ) [ toplamda 18.yılımı tamamladım ]

- korktuğunuz konuların üzerine gidin, korkmayın! koddan korkmayın! ve asla yılmayın!

( zamanında korktuğum tüm kodlarla şimdi cirit atmanın mutluluğu içerisindeyim )

- her zaman okuyun ! nerde ne varsa okuyun ! yazının uzunu kısası olmaz!

( bir iskoç atasözü der ki:

"akıllı adam aklını kullanır, daha akıllı adam başkalarının aklını da kullanır" )

- başkalarının yazdığı programları sapına kadar incik cıcık edene kadar inceleyin!

( içini dışını, neyi nasıl yaptığını iyice karıştırın. değiştirin, değiştirmeye çalışın.

ben olsaydım şunu şöyle yapardım diyin ve yapın! yapana kadar da bırakmayın! )

- düzenli notlarınız ve veri bankanız olsun!

( kritik notlarınızı tutacağınız kalınca defterleriniz olsun, elle yazmaya üşeniyorsanız,

kendinize program yazın, aradığınız kodu hemen bulun, ve ezberleyin! ezberlemenize

gerek kalmayacak zaten. Kullandıkça beyninize yerleşecek. işleyen demir pas tutmaz! )

- boş vakitlerinizde sürekli algoritma ve mantık kurun! bu sizi güçlendirir!

( ne zaman boş kalsam, beynimin diğer bir cpu bölgesinde threadlar çalışmaya başlar.

şu komponentimi şöyle yaparsam daha etkin olur, şu structure yapısına şu diziyi de

bağlarsam aradığım bilgiye daha hızlı ulaşırım, değişken türünü de otomatiğe bağlarsam

şıkıdım şıkdım.. gibi kurgular kurun! programcılığın delilik aşamasına gelmiş bir halidir bu )

- yazdığınız programları iyi arşivleyin ve tarih belirtin. hangi tarihte ne yaptığınızı bilin!

( klasör sisteminizi tarihe göre kurgulayın. göreceksiniz ki geçen seneki kodlamanız ile

şimdiki kodlamanız arasında yedi dağlar şelaleler kadar fark olacaktır! )

- piyasadaki sizi ilgilendiren tüm kitapları boş vakitlerinizde okuyun !

( zamanı geldiğinde kitaplarla alay etmesini de bileceksiniz..... )

- kodlama becerinizi geliştirin! CODER olun !

( başkasının yazdığı kodu gözünüzle incelediğinizde eleştirin, nasıl çalışacağını tahmin edin,

koddaki optimizasyonları yapın, gözünüzle takip edin ve yeri geldiğinde gülün !

kendinize olan güveninizi artırın! yeri geldiğinde de kalite kodlama yapısını

kendinize örnek alın! örnek olarak, şu delphiturk'un kod bankasında benim

en fiyakalı ve yakışıklı gördüğüm kod şu olmuştur, halen de bu kodu takdir ederim:

function SayiOku(Sayi:String; Bosluk:Boolean=False):String;

// Bu fonksiyon -fatihçopur- tarafından yazılmıştır (Made in Turkiye)

// girilen 36 basamaklı sayının okunuşunu döndürür

var

Basamak:Array[0..2] of Byte;

i,j:Byte;

BoslukStr,Birler,Yuzler,Boluk,UBSayi,UBSayiOkunusu:String;

Begin

if Bosluk then BoslukStr:=' ' else BoslukStr:='';

Birler := ' bir iki üç dört beş altı yedi sekizdokuz';

Sayi := Stringofchar('0',36 - Length(Sayi)) + Sayi;

for i := 0 to 11 do begin

UBSayi := copy(Sayi, 3 * i + 1, 3); UBSayiOkunusu := '';

if ((i <> 10) or (UBSayi <> '001')) and (UBSayi <> '000') then begin

for j := 0 to 2 do Basamak[j] := strtoint(copy(UBSayi, j + 1, 1));

Yuzler := '';

if Basamak[0] = 1 then

Yuzler := BoslukStr + 'yüz'

else if Basamak[0] > 1 then

Yuzler := Trimright(BoslukStr + copy(Birler, 5 * Basamak[0] + 1, 5)) + BoslukStr + 'yüz';

UBSayiOkunusu := Yuzler + Trimright(BoslukStr + copy(' on yirmi otuz kırk elli altmışyetmişseksendoksan', 6 * Basamak[1] + 1, 6)) + Trimright(BoslukStr + copy(Birler, 5 * Basamak[2] + 1, 5));

end;

if UBSayi = '000' then Boluk := '' else Boluk := TrimRight(BoslukStr + copy('desilyon nonilyon oktilyon septilyon sekstilyonkentilyon katrilyon trilyon milyar milyon bin ', 10 * i + 1, 10)); // sekstilyon yerine hekstilyon da kullanılabilir.

result := Trimleft(result + UBSayiOkunusu + Boluk);

end;

end.

LEVEL - I ( DELPHI - CODER )

Example - 1: [ 5 puan ]

Var a,b:integer;

Begin

A:=5;

B:=10;

Edit1.text:=inttostr(a+b);

End;

Programın çıktısı ne olur, varsa hataları düzeltin ?

Example - 2: [ 15 puan ]

Var a,b,c:real;

Begin

a:=strtoint(edit1.text);

b:=strtoint(edit2.text);

c:=strtoint(edit3.text);

t:=a+b+c;

showmessage(t);

End;

Programın çıktısı ne olur, varsa hataları düzeltin ?

Example - 3: [ 30 puan ]

Var dugme:boolean;metin:string;sonuc:real;

Begin

Metin:='ahmet';

Sonuc:='10';

Dugme:=inputquery('Veri girişi','Bir sayı giriniz',metin);

İf dugme then

Begin

Sonuc:=inttostr(metin*0.18);

Showmessage(sonuc);

End;

Programın çıktısı ne olur, varsa hataları düzeltin ?

Example - 4: [ 3 puan ]

Var a1,a2,a3:string;

Begin

a1:=edit1.text;

a2:=edit2.text;

a3:=edit3.text;

showmessage(a1+' '+a2+' '+a3);

End;

Programın çıktısı ne olur, varsa hataları düzeltin ?

Example - 5: [ 5 puan ]

Var m:integer;

Begin

For m:=1 to 100 do

Begin

Memo1.lines.add(inttostr(m)+' '+inttostr(sqr(m)));

End;

Programın çıktısı ne olur, varsa hataları düzeltin ?

Example - 6: [ 5 puan ]

Var a,b:string;sonuc:real;

Begin

a:=edit1.text;

b:=edit2.text;

sonuc:=strtofloatdef(a,0)+ strtofloatdef(b,0);

showmessage(floattostr(sonuc));

end;