سلام به دوستان عزیز که منو تنها نمی ذارن.
راستش اتفاقی وبلاگمو باز کردم. الان مدت هاست که دیگه چیزی نمی نوشتم.
امروز دیدم برای مطلبی که 2 سال پیش تو وبلاگ نوشته بودم نظر داده شده....
اگه بازم بازدید کننده باشه که نظر به تمرینا هم بده دوباره شروع می کنم به نوشتن.
حرفای زیادی برای گفتن دارم که به اینجا گفتن افاده نمی کنه.
شاد پیروز و سلامت باشید

تا الان شده که کسی پشت سیستم شما بشینه و برنامه هاتونو نگاه کنه و بعد انکار کنه بگه اون ساعت کار نکردم.

با این برنامه می تونید زمان و تاریخ دقیق آخرین دسترسی به یک فایل  رو ببینید.

خوب شروع می کنیم یک Button , یک Memo روی فرم بذارید و برای Button دستورات زیر را بنویسید.

 

 

procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec : TSearchRec;
Success : integer;
DT : TFileTime;
ST : TSystemTime;
begin
Memo1.Font.Name:='Tahoma';
Success := SysUtils.FindFirst('c:\Yahoo!\YPager.exe'{ اسم و آدرس فایل با پسوند },faAnyFile,SearchRec);
if (Success = 0) and
((SearchRec.FindData.ftLastAccessTime.dwLowDateTime <> 0 ) or
(SearchRec.FindData.ftLastAccessTime.dwHighDateTime <> 0 )) then
begin
FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime,DT);
FileTimeToSystemTime(DT,ST);
Memo1.Lines.Clear;
Memo1.Lines.Add('آخرین زمان و تاریخ دسترسی به فایل ');
Memo1.Lines.Add('سال = ' + IntToStr(ST.wYear));
Memo1.Lines.Add('ماه = ' + IntToStr(ST.wMonth));
Memo1.Lines.Add('روز از هفته= ' + IntToStr(ST.wDayOfWeek));
Memo1.Lines.Add('روز = ' + IntToStr(ST.wDay));
Memo1.Lines.Add('ساعت = ' + IntToStr(ST.wHour));
Memo1.Lines.Add('دقیقه = ' + IntToStr(ST.wMinute));
Memo1.Lines.Add('ثانیه= ' + IntToStr(ST.wSecond));
Memo1.Lines.Add('میلی ثانیه = ' +IntToStr(ST.wMilliseconds));
end;
SysUtils.FindClose(SearchRec);

end;
 

با این Procedure می تونید یک فایل رو از سیستم به جای دیگر انتقال دهید.این رویه دو مقدار می گیرد که اولی فایل مورد نظر برای انتقال و پارامتر دومی مسیر جدید یا محل Past شدن.

ابتدا رویه را بصورت زیر تعریف کنید.

 

procedure CopyFile(const FromFile,ToFile : string);
var
FromF,ToF : File;
NumRead,NumWritten : integer;
Buf : Array[1..2048] of char;
begin
AssignFile(FromF,FromFile);
Reset(FromF,1);
AssignFile(ToF,ToFile);
Rewrite(ToF,1);
repeat
BlockRead(FromF,Buf,SizeOf(Buf),NumRead);
BlockWrite(ToF,Buf,NumRead,NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
 

 

الان یه Button بذارید و از رویه استفاده کنید مثلاً

 

procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFile('c:\camera.exe','d:\119.exe');
end;

برای این کار هم با  Procedure  زیر می تونید این کار رو انجام بدید . از Unit Registry  و ShlObj  استفاده می کنیم. بعد نوع میانبر که در دسکتاپ یا استارت منو یا ... باشد . اون وقت می ریم سراغ رویه که کار اصلی رو میخواد انجام بده. به عنوان مثال Notepad  ویندوز رو میانبر میکنیم به دسکتاپ.

یه Button  بذارید برای فراخوانی رویه.     

 

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Registry,ShlObj,ComObj, StdCtrls;

type
ShortcutType = (_DESKTOP,_QUICKLAUNCH,_SENDTO,_STARTMENU);

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

//تعریف رویه
procedure CreateShortCut(FileName: string;Location: Shortcuttype);
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory,LinkName : string;
WfileName : WideString;
MyReg,QuickLaunchReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
MySLink.SetPath(PChar(FileName));
MyReg := TRegIniFile.Create('Software\Microsoft\Windows\CurrentVersion\Explorer');
try
LinkName := ChangeFileExt(FileName,'.lnk');
LinkName := ExtractFileName(LinkName);
case Location of
_DESKTOP: Directory := MyReg.ReadString('Shell Folders','Desktop','');
_STARTMENU: Directory := MyReg.ReadString('Shell Folders','Start Menu','');
_SENDTO: Directory := MyReg.ReadString('Shell Folders','SendTo','');
_QUICKLAUNCH:
begin
QuickLaunchReg := TRegIniFile.Create(
'Software\Microsoft\Windows\CurrentVersion\GrpConv');
try
Directory := QuickLaunchReg.ReadString('MapGroups','Quick Launch','');
finally
QuickLaunchReg.Free;
end;
end;
end;
if Directory <> '' then
begin
WFileName := Directory + '\' + LinkName;
MyPFile.Save(PWChar(WfileName),False);
end;
finally
MyReg.Free;
end;
end;
 

//فراخوانی رویه

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateShortCut('d:\\windows\\Notepad.exe',_DESKTOP);
end;

end.

 

ابتدا Registry رو به بخش Uses ها اضافه می کنیم. بعد چهار تا Edit و چهار تا Button روی فرم می ذاریم.

می خواهیم کلید اوّل مسیر ویندوز نصب شده رو تو Edit1 مشخص کنه پس Caption Buton1 رو بذارید Get Windows Path حالا  برای همین کلید این دستورات رو بنویسید.

procedure TForm1.Button1Click(Sender: TObject);
var
WinDir: Array[0..MAX_PATH -1] of char;
Result: string;
begin
SetString(Result,WinDir,GetWindowsDirectory(WinDir,MAX_PATH));
Edit1.Text:=WinDir;
end;
 

خوب تو کلید بعدی هم می خواهیم مسیر system32  رو پیدا کنیم پس مثل کلید اول ابتدا Coption این کلید رو می ذاریم Get System Path و این دستورات رو می نویسیم.

var
SysDir: Array[0..MAX_PATH -1] of char;
Result: string;
begin
SetString(Result,SysDir,GetSystemDirectory(SysDir,MAX_PATH));
Edit2.Text:=SysDir;
end;
 

 

برای کلید سومی هم می خواهیم مسیر Program Files رو پیدا کنیم  Caption این کلید رو می ذاریم Get Program Files Path بعد دستورات زیر رو براش می نویسیم .

procedure TForm1.Button3Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',False);
Edit3.Text:=Reg.ReadString('ProgramFilesDir');
Reg.CloseKey;
end;
 

برای کلید و ادیت چهارم هم می خواهیم مسیر Temp  رو نشون بدیم پس Caption این کلید رو می ذاریم Get Temp Path  و بعد این دستورات رو براش می نویسیم.

var
TempDir: Array[0..MAX_PATH -1] of char;
Result: string;
begin
SetString(Result,TempDir,GetTempPath(MAX_PATH,TempDir));
Edit4.Text:=TempDir;
end;

یه Button  روی فرم بذارید و این دستورات رو بنویسید .

procedure TForm1.Button1Click(Sender: TObject);
var
pid1: PitemIDList;
buf: Array[0..Max_PATH] of char;
begin
if Succeeded(ShGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,pid1)) then
begin
if ShGetPathfromIDList(pid1,buf) then ShowMessage(buf) ;
CoTaskMemFree(pid1);
end;
end;

چند تا از دوستان اینو می خواستن. حالا دو تا Buton بذارید روی فرم و Caption اولی رو بذارید Fa  و دومی هم En

حالا برای Button1 اینو بنویسید .

procedure TForm1.Button1Click(Sender: TObject);
begin
 LoadKeyboardLayout('00000429',KLF_ACTIVATE);

end;

و برای Button2 هم این .

procedure TForm1.Button1Click(Sender: TObject);
begin
 LoadKeyboardLayout('00000409',KLF_ACTIVATE);

end;