قرار دادن يك Bitmap در يك متافايل
قرار دادن يك Bitmap در يك متافايل
کد:
procedure TForm1.Button1Click(Sender: TObject);
var
m : TmetaFile;
mc : TmetaFileCanvas;
b : tbitmap;
begin
m := TMetaFile.Create;
b := TBitmap.create;
b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');
m.Height := b.Height;
m.Width := b.Width;
mc := TMetafileCanvas.Create(m, 0);
mc.Draw(0, 0, b);
mc.Free;
b.Free;
m.SaveToFile('C:\SomePath\Test.emf');
m.Free;
Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');
end;
بدست آوردن Serial Number درايو
بدست آوردن Serial Number درايو
کد:
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeName,
FileSystemName : array [0..MAX_PATH-1] of Char;
VolumeSerialNo : DWord;
MaxComponentLength,
FileSystemFlags : Integer;
begin
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,
MaxComponentLength,FileSystemFlags,
FileSystemName,MAX_PATH);
Memo1.Lines.Add('VName = '+VolumeName);
Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8));
Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength));
Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4));
Memo1.Lines.Add('FSName = '+FileSystemName);
end;
از بين بردن يك Task در ويندوز
از بين بردن يك Task در ويندوز
از بين بردن يك Task در ويندوز
با استفاده از اين فانكشن كوچولو ميتونيد هر نوع برنامه اجرا شده اي رو كه پسوند .Exe دارد، از ليست Task Manager ويندوز پاك كنيد
مثال:
کد:
KillTask('notepad.exe');
KillTask('iexplore.exe'); }
کد:
uses
Tlhelp32, Windows, SysUtils;
function KillTask(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot
(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(
PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,
FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
عمليات قابل انجام روي فلاپي ديسك
عمليات قابل انجام روي فلاپي ديسك
اين كد كليه فانكشكنهايي كه براي كار با فلاپي درايو مورد نياز است را در بردارد.
کد:
unit lDrives;
interface
uses Forms, Messages, Classes, WinProcs, WinTypes, SysUtils,
Dialogs, Controls;
const
MsgAskDefault = 'Please insert a disk on drive %s:';
MsgWProtected = 'Error: The disk %s is write-protected.';
type
TDriveType = (dtAll,dtFixed,dtRemovable,dtRemote{$IFDEF WIN32},dtCDRom,dtRamDisk{$ENDIF});
function ComposeFileName (Dir,Name:string):string;
function HasDiskSpace({$IFDEF WIN32}Drive: string{$ELSE}Drive: char{$ENDIF}; MinRequired: LongInt): boolean;
function GetDirectorySize(const Path: string): LongInt;
function GetFileSizeByName(const Filename: string): longInt;
function IsDiskRemovable(Drive: char): boolean;
function IsDiskInDrive(Drive: char): boolean;
function IsDiskWriteProtected(Drive: char): boolean;
function AskForDisk(Drive: char; Msg: string; CheckWriteProtected: boolean): boolean;
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
implementation
function ComposeFileName (Dir,Name:string):string;
var
Separator: string[1];
begin
if (length(Dir) > 0) and (Dir[length(Dir)]='\') then
delete(Dir, length(Dir), 1);
if (length(Name) > 0) and (Name[1]='\') then
delete(Name, 1, 1);
if Name='' then Separator:='' else Separator:='\';
result:=format('%s%s%s',[Dir,Separator,Name]);
end;
function HasDiskSpace(Drive: {$IFDEF WIN32}string{$ELSE}char{$ENDIF}; MinRequired: LongInt): boolean;
begin
if Drive='' then Drive:='C';
{$IFDEF WIN32}
result:=((GetDriveType(PChar(Drive))<>0) and
(SysUtils.DiskFree(Ord(UpCase(Drive[1]))-$40)=-1) or
(SysUtils.DiskFree(Ord(UpCase(Drive[1]))-$40)>=MinRequired));
{$ELSE}
result:=((GetDriveType(Ord(UpCase(Drive))-$40)<>0) and
(DiskFree(Ord(UpCase(Drive))-$40)=-1) or
(DiskFree(Ord(UpCase(Drive))-$40)>=MinRequired));
{$ENDIF}
end;
function GetDirectorySize(const Path: string): LongInt;
var
S: TSearchRec;
TotalSize: LongInt;
begin
TotalSize:=0;
if FindFirst(ComposeFileName(Path,'*.*'), faAnyFile, S)=0 then
repeat
Inc(TotalSize, S.Size);
until FindNext(S)<>0;
result:=TotalSize;
end;
function GetFileSizeByName(const Filename: string): longInt;
var
F: File;
begin
AssignFile(F, Filename);
Reset(F,1);
result:=FileSize(F);
CloseFile(F);
end;
function IsDiskRemovable(Drive: char): boolean;
begin
{$IFDEF WIN32}
result:=GetDriveType(PChar(Drive+':\'))=DRIVE_REMOVABLE;
{$ELSE}
result:=GetDriveType(ord(UpCase(Drive))-65)=DRIVE_REMOVABLE;
{$ENDIF}
end;
function IsDiskInDrive(Drive: char): Boolean;
var
ErrorMode: word;
begin
Drive:=Upcase(Drive);
if not (Drive in ['A'..'Z']) then
begin
Result:=False;
Exit;
end;
ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(Ord(Drive) - 64) = -1 then
Result := False
else
Result := True;
finally
SetErrorMode(ErrorMode);
end;
end;
function IsDiskWriteProtected(Drive: char): Boolean;
var
F: File;
ErrorMode: Word;
begin
ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
AssignFile(F,Drive+':\_$.$$$');
try
try
Rewrite(F);
CloseFile(F);
Erase(F);
Result:=False;
except
Result:=True;
end;
finally
SetErrorMode(ErrorMode);
end;
end;
{$IFDEF WIN32}
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
var
Drive: Integer;
DriveLetter: string;
begin
Items.Clear;
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('A'))+':\';
case DriveType of
dtAll : if GetDriveType(PChar(DriveLetter)) in [DRIVE_REMOVABLE,DRIVE_FIXED,DRIVE_REMOTE,
DRIVE_CDROM,DRIVE_RAMDISK] then
Items.Add(DriveLetter);
dtRemovable: if GetDriveType(PChar(DriveLetter))=DRIVE_REMOVABLE then
Items.Add(DriveLetter);
dtFixed : if GetDriveType(PChar(DriveLetter))=DRIVE_FIXED then
Items.Add(DriveLetter);
dtRemote : if GetDriveType(PChar(DriveLetter))=DRIVE_REMOTE then
Items.Add(DriveLetter);
dtCDRom : if GetDriveType(PChar(DriveLetter))=DRIVE_CDROM then
Items.Add(DriveLetter);
dtRamDisk : if GetDriveType(PChar(DriveLetter))=DRIVE_RAMDISK then
Items.Add(DriveLetter);
end;
end;
end;
{$ELSE}
procedure GetAvailableDrives(DriveType: TDriveType; Items: TStrings);
var
Drive: Integer;
DriveLetter: char;
begin
Items.Clear;
for Drive := 0 to 25 do
begin
DriveLetter := Chr(Drive + ord('A'));
case DriveType of
dtAll : if GetDriveType(Drive) in [DRIVE_REMOVABLE,DRIVE_FIXED,DRIVE_REMOTE] then
Items.Add(DriveLetter+':\');
dtRemovable: if GetDriveType(Drive)=DRIVE_REMOVABLE then
Items.Add(DriveLetter+':\');
dtFixed : if GetDriveType(Drive)=DRIVE_FIXED then
Items.Add(DriveLetter+':\');
dtRemote : if GetDriveType(Drive)=DRIVE_REMOTE then
Items.Add(DriveLetter+':\');
end;
end;
end;
{$ENDIF}
function AskForDisk(Drive: char; Msg: string; CheckWriteProtected: boolean): boolean;
var
Ready : boolean;
begin
Ready:=false; Result:=false;
if Msg='' then Msg:=Format(MsgAskDefault,[Drive]);
while not(Ready) do
try
if IsDiskRemovable(Drive) then
case MessageDlg(Msg, mtConfirmation, [mbOk,mbCancel],0) of
mrOk : ready:=IsDiskInDrive(Drive);
mrCancel: exit;
end
else
Ready:=true;
except
result:=false;
exit;
end;
ready:=false;
while not(Ready) do
try
if CheckWriteProtected and IsDiskWriteProtected(Drive) then
begin
ready:=false;
if MessageDlg(Format(MsgWProtected,[Upcase(Drive)+':']),mtError,[mbRetry,mbCancel],0)=mrCancel then
exit;
end
else
ready:=true;
except
result:=false;
exit;
end;
result:=Ready;
end;
end.
استفاده از الگوريتم Base64 جهت Encoding و Decoding
استفاده از الگوريتم ------ جهت Encoding و Decoding
کد:
function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var
I: LongInt;
begin
case Length(S) of
2:
begin
I := Map[S[1]] + (Map[S[2]] shl 6);
SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
SetLength(Result, 2);
Move(I, Result[1], Length(Result))
end;
4:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
(Map[S[4]] shl 18);
SetLength(Result, 3);
Move(I, Result[1], Length(Result))
end
end
end;
function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
I: LongInt;
begin
I := 0;
Move(S[1], I, Length(S));
case Length(S) of
1:
Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64];
3:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end
end;