Printable View
function StrToAnsiFileName(s: string): string;
var
i: integer;
begin
result := '';
for i := 1 to length(s) do
if s[i] in ['0'..'9', 'a'..'z', 'A'..'Z', '_', '.', ' '] then
result := result + s[i];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(StrToAnsiFileName('ÓáÇã adff 13.jpg'));
end;
یک تابع ساده برای تبدیل به string
function ValToString(Value: Variant): String;
begin
case TVarData(Value).VType of
varSmallInt,
varInteger : Result := IntToStr(Value);
varSingle,
varDouble,
varCurrency : Result := FloatToStr(Value);
varDate : Result := FormatDateTime('dd.mm.yyyy', Value);
varBoolean : if Value then Result := 'T' else Result := 'F';
varString : Result := Value;
else Result := '';
end;
end;
استفاده از تابع GetAsyncKeyState برای تشخیص رویداد
procedure TForm1.Timer1Timer(Sender: TObject);
var
i : integer;
begin
for i:=8 To 222 do
begin
if GetAsyncKeyState(i)=-32767 then
begin
case i of
8 : memo1.Lines[memo1.Lines.count-1] := copy(memo1.Lines[memo1.Lines.count-1],1,length(memo1.Lines[memo1.Lines.count-1])-1); //Backspace
9 : memo1.text:=memo1.text+'[Tab]';
13 : memo1.text:=memo1.text+#13#10; //Enter
17 : memo1.text:=memo1.text+'[Ctrl]';
27 : memo1.text:=memo1.text+'[Esc]';
32 :memo1.text:=memo1.text+' '; //Space
// Del,Ins,Home,PageUp,PageDown,End
33 : memo1.text := Memo1.text + '[Page Up]';
34 : memo1.text := Memo1.text + '[Page Down]';
35 : memo1.text := Memo1.text + '[End]';
36 : memo1.text := Memo1.text + '[Home]';
//Arrow Up Down Left Right
37 : memo1.text := Memo1.text + '[Left]';
38 : memo1.text := Memo1.text + '[Up]';
39 : memo1.text := Memo1.text + '[Right]';
40 : memo1.text := Memo1.text + '[Down]';
44 : memo1.text := Memo1.text + '[Print Screen]';
45 : memo1.text := Memo1.text + '[Insert]';
46 : memo1.text := Memo1.text + '[Del]';
145 : memo1.text := Memo1.text + '[Scroll Lock]';
//Number 1234567890 Symbol !@#$%^&*()
48 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+')'
else memo1.text:=memo1.text+'0';
49 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'!'
else memo1.text:=memo1.text+'1';
50 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'@'
else memo1.text:=memo1.text+'2';
51 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'#'
else memo1.text:=memo1.text+'3';
52 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'$'
else memo1.text:=memo1.text+'4';
53 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'%'
else memo1.text:=memo1.text+'5';
54 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'^'
else memo1.text:=memo1.text+'6';
55 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'&'
else memo1.text:=memo1.text+'7';
56 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'*'
else memo1.text:=memo1.text+'8';
57 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'('
else memo1.text:=memo1.text+'9';
65..90 : // a..z , A..Z
begin
if ((GetKeyState(VK_CAPITAL))=1) then
if GetKeyState(VK_SHIFT)<0 then
memo1.text:=memo1.text+LowerCase(Chr(i)) //a..z
else
memo1.text:=memo1.text+UpperCase(Chr(i)) //A..Z
else
if GetKeyState(VK_SHIFT)<0 then
memo1.text:=memo1.text+UpperCase(Chr(i)) //A..Z
else
memo1.text:=memo1.text+LowerCase(Chr(i)); //a..z
end;
//Numpad
96..105 : memo1.text:=memo1.text + inttostr(i-96); //Numpad 0..9
106:memo1.text:=memo1.text+'*';
107:memo1.text:=memo1.text+'&';
109:memo1.text:=memo1.text+'-';
110:memo1.text:=memo1.text+'.';
111:memo1.text:=memo1.text+'/';
144 : memo1.text:=memo1.text+'[Num Lock]';
112..123: //F1-F12
memo1.text:=memo1.text+'[F'+IntToStr(i - 111)+']';
186 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+':'
else memo1.text:=memo1.text+';';
187 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'+'
else memo1.text:=memo1.text+'=';
188 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'<'
else memo1.text:=memo1.text+',';
189 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'_'
else memo1.text:=memo1.text+'-';
190 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'>'
else memo1.text:=memo1.text+'.';
191 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'?'
else memo1.text:=memo1.text+'/';
192 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'~'
else memo1.text:=memo1.text+'`';
219 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'{'
else memo1.text:=memo1.text+'[';
220 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'|'
else memo1.text:=memo1.text+'\';
221 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'}'
else memo1.text:=memo1.text+']';
222 : if GetKeyState(VK_SHIFT)<0 then memo1.text:=memo1.text+'"'
else memo1.text:=memo1.text+'''';
end;
end;
end;
end;
ایجاد حاشیه یا همون Margin در Memo
var Rect: TRect;
begin
SendMessage( Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
Rect.Left:= 30;
SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
Memo1.Refresh;
دیگه به توضیح نیاز نداره:لبخند:
unit unt_DriverList;
(*
Coded By : Behrooz Abbassi (Saam)
*)
interface
Uses
Vcl.Graphics,
Vcl.Controls,
Vcl.ComCtrls,
Winapi.Windows,
Winapi.PsAPI,
Winapi.ShellAPI,
System.StrUtils,
System.SysUtils;
type
TDriverList = class(TObject)
private
FIcon: TIcon;
FSmallIcon: TImageList;
function Get_WinSysDir: string;
function Get_FileIcon(const fFileName: string): TIcon;
const
SErrorMessage = 'Failed to enumerate drivers. Make sure ' +
'PSAPI.DLL is installed on your system.';
public
constructor Create;
destructor Destroy;
procedure Get_DriverList(Listview: TListView);
end;
implementation
{ TDriverList }
constructor TDriverList.Create;
begin
FSmallIcon := TImageList.Create(nil);
FIcon := TIcon.Create;
end;
destructor TDriverList.Destroy;
begin
FSmallIcon.Free;
FIcon.Free;
end;
procedure TDriverList.Get_DriverList(Listview: TListView);
var
strTempName: string;
I: Integer;
dwCount: DWORD;
FDrvlist: array of Pointer;
BigArray: array [0 .. $3FFF - 1] of DWORD;
DrvName: array [0 .. MAX_PATH] of char;
varout: word;
begin
Listview.SmallImages := FSmallIcon;
if not EnumDeviceDrivers(@BigArray, SizeOf(BigArray), dwCount) then
raise Exception.Create(SErrorMessage);
SetLength(FDrvlist, dwCount div SizeOf(DWORD));
Move(BigArray, FDrvlist[0], dwCount);
for I := low(FDrvlist) to High(FDrvlist) do
begin
if GetDeviceDriverFileName(FDrvlist[I], DrvName, SizeOf(DrvName)) > 0 then
begin
with Listview.Items.Add do
begin
Caption := ExtractFileName(DrvName);
if FileExists(Get_WinSysDir + '\' + Caption) then
strTempName := Get_WinSysDir + '\' + Caption
else if FileExists(Get_WinSysDir + '\Drivers\' + Caption) then
strTempName := Get_WinSysDir + '\Drivers\' + Caption
else
strTempName := DrvName;
if LeftStr(strTempName, Length('\??\')) = '\??\' then
begin
strTempName := ReplaceStr(strTempName, '\??\', '');
end;
if LeftStr(strTempName, Length('\SystemRoot')) = '\SystemRoot' then
begin
strTempName := LeftStr(Get_WinSysDir, 2) + ReplaceStr(strTempName,
'SystemRoot', 'Windows');
end;
if LeftStr(strTempName, Length('\Windows')) = '\Windows' then
begin
strTempName := LeftStr(Get_WinSysDir, 2)+strTempName;
end;
SubItems.Add(strTempName);
SubItems.Add(Format('%p', [FDrvlist[I]]));
if FileExists(strTempName) then
ImageIndex := FSmallIcon.AddIcon(Get_FileIcon(strTempName));
end;
end;
end;
end;
function TDriverList.Get_FileIcon(const fFileName: string): TIcon;
function GetIcon(const FileN: string; bLIcon: Boolean = true): TSHFileInfo;
begin
if bLIcon then
begin
ShGetFileInfo(Pchar((FileN)), 0, Result, SizeOf(Result), SHGFI_TYPENAME or
SHGFI_ICON or SHGFI_LARGEICON or SHGFI_LARGEICON);
end
else if not(bLIcon) then
begin
ShGetFileInfo(Pchar((FileN)), 0, Result, SizeOf(Result), SHGFI_TYPENAME or
SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SMALLICON);
end;
end;
begin { Small }
FIcon.Handle := GetIcon(fFileName, False).HICON;
Result := FIcon;
end;
function TDriverList.Get_WinSysDir: string;
{$IFDEF MSWINDOWS }
var
Buffer: array [0 .. 255] of char;
begin
GetWindowsDirectory(Buffer, MAX_PATH);
Result := StrPas(Buffer) + '\';
{$ENDIF MSWINDOWS }
end;
end.
نحوه استفاده :
var
DL: TDriverList;
begin
DL := TDriverList.Create;
try
DL.Get_DriverList(LV);
finally
DL.Free;
end;
که LV یک کنترل ListView اه.
درود به همه
با این نمونه برنامه میتونید توی console از نوشته های رنگی و گل منگولی:لبخند: استفاده کنید.
program Project1;
{$APPTYPE CONSOLE}
uses
System.SysUtils, Winapi.Windows;
var
hConsole: NativeUInt;
const
cl_Black = 0;
cl_Navy = 1;
cl_Green = 2;
cl_Teal = 3;
cl_Maroon = 4;
cl_Purple = 5;
cl_Brown = 6;
cl_Silver = 7;
cl_Gray = 8;
cl_Blue = 9;
cl_Lime = 10;
cl_Aqua = 11;
cl_Red = 12;
cl_Fuchsia = 13;
cl_Yellow = 14;
cl_White = 15;
begin
hConsole := GetStdHandle(STD_OUTPUT_HANDLE);
SetConsoleTitle('Colored Console in Delphi XE3');
SetConsoleTextAttribute(hConsole, cl_Yellow);
Writeln('Coded by : Opc0d3 ');
SetConsoleTextAttribute(hConsole, cl_Fuchsia);
Writeln('-----------------------------------------');
SetConsoleTextAttribute(hConsole, cl_red);
Writeln(' Barnamenevis.ORG ');
SetConsoleTextAttribute(hConsole, cl_Green);
Writeln('-----------------------------------------');
SetConsoleTextAttribute(hConsole, cl_Blue);
SetConsoleTextAttribute(hConsole, RGB(100, 0, 0));
Writeln('ABCD');
Readln;
end.
شاعر میگه این تابع بهتره ! بعد ویرایش :
var
hConsole: NativeUInt;
i: Integer;
type
TColor = (cl_Black = 0, cl_Navy = 1, cl_Green = 2, cl_Teal = 3, cl_Maroon = 4,
cl_Purple = 5, cl_Brown = 6, cl_Silver = 7, cl_Gray = 8, cl_Blue = 9,
cl_Lime = 10, cl_Aqua = 11, cl_Red = 12, cl_Fuchsia = 13, cl_Yellow = 14,
cl_White = 15);
//
Procedure WriteColored(const AText: AnsiString; ATextColor: TColor);
begin
hConsole := GetStdHandle(STD_OUTPUT_HANDLE);
SetConsoleTextAttribute(hConsole, Ord(ATextColor));
Writeln(AText);
SetConsoleTextAttribute(hConsole, 15);
end;
مثال :
WriteColored('yooooooooooooooooooooohOW!',cl_Green );
گرفتن لیست پروسه های در حال اجرا به همراه آدرس فایل اجرایی بدون نیاز به دسترسی Admin یا ... به وسیله توابع Process32First و Process32Next :
function GetprocessList(ProcessList: TStrings): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
ProcessList.Clear;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
ProcessList.Add(FProcessEntry32.szExeFile);
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
finally
CloseHandle(FSnapshotHandle);
end;
end;
کُد شما در همه سیستم ها نمیتونه آدرس یا نام همه پروسه ها رو به درستی نمایش بده.نقل قول:
نوشته شده توسط Mahan-1363
نمیدونم این کُدها رو توی سایت گذاشتم یا نه، از ویندوز 32 XP تا WIn8 64 تست شده و جواب میده:
function EnableDebugPrivileges: THandle;
var
lpLuid : TOKEN_PRIVILEGES;
OldlpLuid : TOKEN_PRIVILEGES;
ReturnLength : DWORD;
begin
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Result) then begin
if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', lpLuid.Privileges[0].Luid) then
RaiseLastOSError
else
begin
lpLuid.PrivilegeCount := 1;
lpLuid.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
ReturnLength := 0;
OldlpLuid := lpLuid;
//Set the SeDebugPrivilege privilege
if not AdjustTokenPrivileges(Result, False, lpLuid, SizeOf(OldlpLuid), OldlpLuid, ReturnLength) then
RaiseLastOSError;
end;
end else
RaiseLastOSError;
end;
function GetProcFullPathVista(ProcessId: Cardinal): string;
var
ProcessIdInfo: SYSTEM_PROCESS_ID_INFORMATION;
begin
Result := '';
SetLength(Result, MAX_PATH);
ProcessIdInfo.ProcessId := ProcessId;
ProcessIdInfo.ImageName.Length := 0;
ProcessIdInfo.ImageName.MaximumLength := MAX_PATH;
ProcessIdInfo.ImageName.Buffer := @Result[1];
NtQuerySystemInformation(88, @ProcessIdInfo, SizeOf(SYSTEM_PROCESS_ID_INFORMATION), nil);
SetLength(Result, ProcessIdInfo.ImageName.Length div 2);
Result := DevicePathToWin32Path(Result);
end;
function GetProcFullPathXP(ProcessId: Cardinal): string;
var
ProcessName: array[0..MAX_PATH - 1] of WideChar;
ProcessHandle: THandle;
TokenHandle: THandle;
begin
Result := '';
TokenHandle := EnableDebugPrivileges;
try
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, false, ProcessId);
if (ProcessHandle = 0) or (ProcessHandle = INVALID_HANDLE_VALUE) then Exit;
try
if NtQueryInformationProcess(ProcessHandle, 27, @ProcessName[0], MAX_PATH, nil) = NT_STATUS_SUCCESS then
Result := DevicePathToWin32Path(PUNICODE_STRING(@ProcessName[0])^.Buffer);
finally
CloseHandle(ProcessHandle);
end;
finally
CloseHandle(TokenHandle);
end;
end;
مثلا چه نسخه ای ؟نقل قول:
کُد شما در همه سیستم ها نمیتونه آدرس یا نام همه پروسه ها رو به درستی نمایش بده.
طبق مستندات MSDN :
من کدی که قرار دادم رو از ویندوز XP به بعد تو تمام سیستم عامل ها با شرایط مختلف و نسخه های مختلف سیستم عامل تست کردم ، اگز مشکلی دید بگید بررسی کنم .نقل قول:
Minimum supported client
Windows XP [desktop apps only]
Minimum supported server
Windows Server 2003 [desktop apps only]
اگر قرار باشه کدی درست کار نکنه کد شما هست دوست عزیز ، قبل از نوشتن کد یا استفاده از کدهای موجود ، بررسی کنید ببینید طرف چی کار کرده و بعدا ممکنه براتون چه دردسرهایی درست کنه ، دوباره طبق مستندات MSDN :
NtQuerySystemInformation
نقل قول:
[NtQuerySystemInformation may be altered or unavailable in future versions of Windows. Applications should use the alternate functions listed in this topic.]
Remarks
The NtQuerySystemInformation function and the structures that it returns are internal to the operating system and subject to change from one release of Windows to another. To maintain the compatibility of your application, it is better to use the alternate functions previously mentioned instead.
سلام.نقل قول:
نوشته شده توسط Mahan-1363
شرمنده کُدهاتون رو خوب نگاه نکردم TProcessEntry32 اصلا آدرس فایل اجرایی رو درنمیاره.
برای اینکه بدون نیاز به دسترسی به ادمین آدرس تمام فایلهای اجرایی رو در بیارید حتما باید از همون کُدهایی که نوشتم استفاده کنید.
در ضمن اون مستندات MSDN رو هم خوندم ولی وقتی خودش یه تابع (به قول خودش instead) که کارت رو راه نمیدازه رو بهت معرفی میکنه، چه کار باید بکنی؟
فایل اجرایی یک پروسه همیشه اولین ماژول لود شده توسط اون پروسه هست، پس میشه با خواندن مشخصات اولین ماژول لود شده توسط پروسه، آدرس فایل اجرایی اون رو به دست آورد. برای این کار میشه از تایع Module32First استفاده کرد. اما روش مطمئن تر استفاده از تابع GetModuleFileNameEx با مقدار هندل 0 برای ماژول هست، که آدرس فایل اجرایی را از روی ماژول های لود شده مستقیما برگشت میده:نقل قول:
گرفتن لیست پروسه های در حال اجرا به همراه آدرس فایل اجرایی بدون نیاز به دسترسی Admin
function GetProcessExeFileName(ProcessID: Cardinal): string;
var
hProcess: THandle;
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcessID);
if hProcess <> 0 then
begin
try
SetLength(Result,MAX_PATH);
FillChar(Result[1],Length(Result) * SizeOf(Char), 0);
if GetModuleFileNameEx(hProcess,0,PChar(Result),Lengt h(Result)) > 0 then
Result := Trim(Result)
else
RaiseLastOSError;
finally
CloseHandle(hProcess)
end;
end
else
RaiseLastOSError;
end;
این کد بخشی از کتابخانه ProcessInfo هست که قبلا در اینجا به اشتراک گذاشته بودم، دوباره سورسش رو پیوست می کنم.
تعداد زیادی از پروسه ها رو بدون داشتن دسترسی ادمین نمیتونید openprocess بکنید.نقل قول:
نوشته شده توسط vcldeveloper
هرچند این تاپیک محل بحث نیست ولی خب ، مشکل باید حل بشه .نقل قول:
تعداد زیادی از پروسه ها رو بدون داشتن دسترسی ادمین نمیتونید openprocess بکنید.
من هم همین فکرو میکردم ،شما این تاپیک رو ببین من بدون دسترسی خاصی تمامی پروسه های سیستم رو هم Openprocess کردم چطوری ؟ با کامپایل برنامه در حالت 64بیتی ! چون حداقل توی سیستم من که سیستم عاملم 64بیتی پروسه های سیستمی هم هتدل های 64بیتی دارن و با یک برنامه 32بیتی نمیشه هندل اونا رو با OpenProcess بدست آورد. به تصویری که توی ااون تاپیکه دقت کن.
مشاهده همه پروسه های در حال اجرا در سیستم (32 و 64بیتی)
اگه هدف نوشتن یه برنامه process manager باشه صد در صد توصیه میشه که 64Bit و 32Bit رو جدا جدا بنویسه. ولی اگه توی یه برنامه 32Bit فقط میخواد یه لیست پروسه با آدرس بگیره میتونه از همون کُدهایی که گفتم استفاده بشه تست شده و جواب میده.نقل قول:
هرچند این تاپیک محل بحث نیست ولی خب ، مشکل باید حل بشه .
من هم همین فکرو میکردم ،شما این تاپیک رو ببین من بدون دسترسی خاصی تمامی پروسه های سیستم رو هم Openprocess کردم چطوری ؟ با کامپایل برنامه در حالت 64بیتی ! چون حداقل توی سیستم من که سیستم عاملم 64بیتی پروسه های سیستمی هم هتدل های 64بیتی دارن و با یک برنامه 32بیتی نمیشه هندل اونا رو با OpenProcess بدست آورد. به تصویری که توی ااون تاپیکه دقت کن.
مشاهده همه پروسه های در حال اجرا در سیستم (32 و 64بیتی)
دوستان MadShi یک دستور داره لیست تمام پروسه ها رو می ده، آیا ضعفی داشته که کسی بهش اشاره نکرد؟
از ویندوز ویستا به بعد تابعی به نام QueryFullProcessImageName به API ها اضافه شده که مایکروسافت تو داکیمونت های جدیدش شدیدا داره توصیه به استفادش میکنه ، توسط این تابع میشه از یک پروسه 32 بیتی آدرس فایل اجرایی پروسه های 32 بیتی و 64 بیتی رو به دست آورد .نقل قول:
اما روش مطمئن تر استفاده از تابع GetModuleFileNameEx با مقدار هندل 0 برای ماژول هست، که آدرس فایل اجرایی را از روی ماژول های لود شده مستقیما برگشت میده:
این هم یه نمونه که الان نوشتم :
function QueryFullProcessImageName(hProcess: THandle; dwFlags: DWORD;
lpExeName: PChar; nSize: PDWORD): BOOL; stdcall;
external kernel32 name 'QueryFullProcessImageNameW';
function GetprocessList(ProcessList: TStrings): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
ProcessHandle: THandle;
szPath: array [0 .. MAX_PATH] of Char;
nLen: Cardinal;
begin
nLen := MAX_PATH;
FillChar(szPath, nLen, 0);
ProcessList.Clear;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
// Try to open current process to reterive handle of it to get full path of process
ProcessHandle := OpenProcess($1000, False, FProcessEntry32.th32ProcessID);
try
// Check OpenProcess failed or not
if (ProcessHandle <> 0) then
begin
// Get full path of process
nLen := MAX_PATH;
if QueryFullProcessImageName(ProcessHandle, 0, szPath, @nLen) then
ProcessList.Add(szPath);
end
else // If can not open process to reterive full path of it , just add name of process
ProcessList.Add(FProcessEntry32.szExeFile);
finally
CloseHandle(ProcessHandle);
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
finally
CloseHandle(FSnapshotHandle);
end;
end;
تائید میشه ، همچین کاری تو ابزارهای SysInternals مثل Process Explorer هم انجام شده .نقل قول:
اگه هدف نوشتن یه برنامه process manager باشه صد در صد توصیه میشه که 64Bit و 32Bit رو جدا جدا بنویسه.
درود به همه
فکرکنید رشته زیر رو دارید
Junk text :-)
Junk text :-)
Junk text :-)
Name: SAAM
Junk text :-)
Junk text :-)
Junk text :-)
Junk text :-)
Junk text :-)
Family: SAAMI
Junk text :-)
Junk text :-)
Junk text :-)
و باید مقادیر SAAM و SAAMI رو برای نام و نام خانوادگی به دست بیارید؛ انجام این کار با روش های معمول پردازش متن کمی سخته ولی با استفاده از RegEx ها به اسانی میتونید این کارو انجام بدید.
مثال
.......
Uses
System.RegularExpressionsCore;
...
var
RX: TPerlRegEx;
i: Integer;
const
RegEx = 'Name:\s?(.*)|Family:\s?(.*)';
begin
i := 1;
RX := TPerlRegEx.Create;
try
RX.RegEx := RegEx;
RX.Subject := mmo1.Text;
if RX.Match then
begin
repeat
case i of
1:
ShowMessage('Name is: ' + RX.Groups[i]);
2:
ShowMessage('Family is: ' + RX.Groups[i]);
end;
Inc(i);
until not RX.MatchAgain;
end;
finally
RX.Free;
end;
...
اینم خروجی :
Name is: SAAM
Family is: SAAMI
روز خوش
ممکنه شما به هردلیل بخواهید از اجرا شدن برنامتون در محیط های مثل VMware مطلع بشید:لبخند:؛ اینجاست که این تابع به شما سلام میده:کف:
در این تابع از نقطه ضعف مربوط به I/O استفاده شده (که با ایجاد تغییرات مناسب در تنظیمات VMware میشه غیر فعالش کرد:ناراحت: )
Function AntiVMware():boolean;
begin
try
asm
push edx;
push ecx;
push ebx;
mov eax, 'VMXh';
mov ebx, 0; // This can be any value except MAGIC
mov ecx, 10; // "CODE" to get the VMware Version
mov edx, 'VX'; // Port Number
in eax, dx; // Read port
//On return EAX returns the VERSION
cmp ebx, 'VMXh'; // is it VMware
setz Result; //Set flag state
pop ebx;
pop ecx;
pop edx;
end;
except
Result:= False;
end;
end;
if AntiVMware then
MessageBox(0, 'VMware Instance Detected', 'VMware Detected', +MB_OK +MB_ICONINFORMATION)
else
MessageBox(0, 'No VMware Instance Detected', 'No VMware Detected', +MB_OK +MB_ICONINFORMATION);
شب خوش .
برای کامپایل این کد نیاز به تعدادی از کتابخانه های mad هست که پیوست شده .
Uses
Madres;
function UpdateExeIcon(exeFile, iconGroup, icoFile: string;
language: Word): boolean;
var
resUpdateHandle: DWORD;
c: TPIconGroup;
begin
resUpdateHandle := BeginUpdateResourceW(PWideChar(wideString(exeFile)
), False);
if resUpdateHandle <> 0 then
begin
if GetIconGroupResourceW(resUpdateHandle, PWideChar(wideString(iconGroup)),
language, c) then
Result := LoadIconGroupResourceW(resUpdateHandle,
PWideChar(wideString(iconGroup)), language,
PWideChar(wideString(icoFile)))
else if StrToIntDef(iconGroup, -1) > -1 then
Result := LoadIconGroupResourceW(resUpdateHandle,
PWideChar(pointer(strtoint(iconGroup))), language,
PWideChar(wideString(icoFile)))
else
Result := False;
Result := EndUpdateResourceW(resUpdateHandle, False) and Result;
end
else
Result := False;
end;
نمونه استفاده :
UpdateExeIcon('ExecutableFile', 'MAINICON', 'IconFile', makelangid(LANG_ENGLISH, SUBLANG_ENGLISH_US));
پارامتر دوم نام Icon Group هست که میتونید توسط برنامه ای مثل Resource Hacker استخراجش کنید ( خودتون هم میتونید بنویسید که این بخش رو به صورت خودکار پیدا کنه ولی من حالشو ندارم ;)
دقت کنید که آیکن یک فایلی بخشی از ریسورس اون هست ، ریسورس یک فایل 64 بیتی فقط با یک پروسه 64 بیتی قابل خوندن و تغییر هست ، پس برای تغییر آیکن یک فایل 64 بیتی این کد باید به صورت 64 بیتی کامپایل بشه ( بررسی نکردم نکردم شاید هم نشه یا کلی دردسر تو کتابخانه های mad پیش بیاد ) .
موفق باشید .
ممکنه شما بخواید از یک Thread مقادیری رو به یک برنامه بدون Form یا یه Procedure توی یک Unit ارسال کنید و خلاصه فرمی و در نتیجه هندلی در کار نباشه اون موقع میشه با استفاده از چنین کدی این کارو انجام داد (اساس کارش تابع AllocateHWnd هستش)
TMessageHandler = Class(TObject)
private
FHandle: HWND;
protected
Property Handle:HWND read FHandle;
Procedure HandleMessage(var message:TMessage);virtual;
public
Constructor Create;virtual;
Destructor Destroy;Override;
End;
constructor TMessageHandler.Create;
begin
inherited Create;
FHandle:=AllocateHWnd(HandleMessage);
end;
destructor TMessageHandler.Destroy;
begin
DeallocateHWnd(FHandle);
inherited;
end;
procedure TMessageHandler.HandleMessage(var Message:TMessage);
begin
Message.Result := DefWindowProc(FHandle, Message.Msg,
Message.wParam, Message.lParam);
end;
منبع :بامزه:
اینم سورس یه برنامه که به جای استفاده از توابع معمول FindXXX برای جستجوی فایل کمی به حفاری پرداخته و از توابع سطح پایین این کار استفاده کرده (NtQueryDirectoryFile)
یونیت 1 :
unit NativeFileApi;
interface
uses
Winapi.Windows;
const
ntdll = 'ntdll.dll';
STATUS_SUCCESS = 0;
// Define the create disposition values
FILE_SUPERSEDE = $00000000;
FILE_OPEN = $00000001;
FILE_CREATE = $00000002;
FILE_OPEN_IF = $00000003;
FILE_OVERWRITE = $00000004;
FILE_OVERWRITE_IF = $00000005;
FILE_MAXIMUM_DISPOSITION = $00000005;
// Define the create / open option flags
FILE_DIRECTORY_FILE = $00000001;
FILE_WRITE_THROUGH = $00000002;
FILE_SEQUENTIAL_ONLY = $00000004;
FILE_NO_INTERMEDIATE_BUFFERING = 00000008;
// Valid values for the Attributes field
OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
OBJ_EXCLUSIVE = $00000020;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
OBJ_OPENLINK = $00000100;
OBJ_KERNEL_HANDLE = $00000200;
OBJ_FORCE_ACCESS_CHECK = $00000400;
OBJ_VALID_ATTRIBUTES = $000007F2;
type
PNTSTATUS = ^NTSTATUS;
NTSTATUS = Integer;
ULONG_PTR = Longword;
USHORT = Word;
PWSTR = LPWSTR;
HANDLE = THandle;
PVOID = Pointer;
CCHAR = Char;
LONG = Longint;
PUNICODE_STRING = ^UNICODE_STRING;
_UNICODE_STRING = Record
Length: USHORT;
MaximumLength: USHORT;
Buffer: PWSTR;
end;
UNICODE_STRING = _UNICODE_STRING;
PCUNICODE_STRING = ^UNICODE_STRING;
TUnicodeString = UNICODE_STRING;
PUnicodeString = PUNICODE_STRING;
PString = ^TString;
_STRING = Record
Length: USHORT;
MaximumLength: USHORT;
Buffer: PAnsiChar;
end;
TString = _STRING;
ANSI_STRING = _STRING;
PANSI_STRING = PString;
LPLARGE_INTEGER = ^LARGE_INTEGER;
{$IFDEF USE_DELPHI_TYPES}
_LARGE_INTEGER = Windows._LARGE_INTEGER;
LARGE_INTEGER = Windows.LARGE_INTEGER;
TLargeInteger = Windows.TLargeInteger;
{$ELSE}
_LARGE_INTEGER = Record
case Integer of
0:
(LowPart: DWORD; HighPart: LONG);
1:
(QuadPart: LONGLONG);
end;
LARGE_INTEGER = _LARGE_INTEGER;
TLargeInteger = LARGE_INTEGER;
{$ENDIF}
PLARGE_INTEGER = ^LARGE_INTEGER;
PLargeInteger = LPLARGE_INTEGER;
LPULARGE_INTEGER = ^ULARGE_INTEGER;
{$IFDEF USE_DELPHI_TYPES}
ULARGE_INTEGER = Windows.ULARGE_INTEGER;
TULargeInteger = Windows.TULargeInteger;
PULargeInteger = Windows.PULargeInteger;
{$ELSE}
ULARGE_INTEGER = record
case Integer of
0:
(LowPart: DWORD; HighPart: DWORD);
1:
(QuadPart: LONGLONG);
end;
TULargeInteger = ULARGE_INTEGER;
PULargeInteger = LPULARGE_INTEGER;
{$ENDIF}
PULARGE_INTEGER = ^ULARGE_INTEGER;
POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;
_OBJECT_ATTRIBUTES = Record
Length: ULONG;
RootDirectory: HANDLE;
ObjectName: PUNICODE_STRING;
Attributes: ULONG;
SecurityDescriptor: PVOID; // Points to type SECURITY_DESCRIPTOR
SecurityQualityOfService: PVOID;
// Points to type SECURITY_QUALITY_OF_SERVICE
end;
OBJECT_ATTRIBUTES = _OBJECT_ATTRIBUTES;
TObjectAttributes = OBJECT_ATTRIBUTES;
PObjectAttributes = POBJECT_ATTRIBUTES;
_IO_STATUS_BLOCK = Record
Status: NTSTATUS;
Information: ULONG_PTR;
end;
IO_STATUS_BLOCK = _IO_STATUS_BLOCK;
PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
TIOStatusBlock = IO_STATUS_BLOCK;
PIOStatusBlock = PIO_STATUS_BLOCK;
PIO_APC_ROUTINE = procedure(ApcContext: PVOID;
IoStatusBlock: PIO_STATUS_BLOCK; Reserved: ULONG); stdcall;
_EVENT_TYPE = (NotificationEvent, SynchronizationEvent);
EVENT_TYPE = _EVENT_TYPE;
PEVENT_TYPE = ^EVENT_TYPE;
_FILE_INFORMATION_CLASS = (FileFiller0, FileDirectoryInformation, // 1
FileFullDirectoryInformation, // 2
FileBothDirectoryInformation, // 3
FileBasicInformation, // 4 wdm
FileStandardInformation, // 5 wdm
FileInternalInformation, // 6
FileEaInformation, // 7
FileAccessInformation, // 8
FileNameInformation, // 9
FileRenameInformation, // 10
FileLinkInformation, // 11
FileNamesInformation, // 12
FileDispositionInformation, // 13
FilePositionInformation, // 14 wdm
FileFullEaInformation, // 15
FileModeInformation, // 16
FileAlignmentInformation, // 17
FileAllInformation, // 18
FileAllocationInformation, // 19
FileEndOfFileInformation, // 20 wdm
FileAlternateNameInformation, // 21
FileStreamInformation, // 22
FilePipeInformation, // 23
FilePipeLocalInformation, // 24
FilePipeRemoteInformation, // 25
FileMailslotQueryInformation, // 26
FileMailslotSetInformation, // 27
FileCompressionInformation, // 28
FileObjectIdInformation, // 29
FileCompletionInformation, // 30
FileMoveClusterInformation, // 31
FileQuotaInformation, // 32
FileReparsePointInformation, // 33
FileNetworkOpenInformation, // 34
FileAttributeTagInformation, // 35
FileTrackingInformation, // 36
FileMaximumInformation);
FILE_INFORMATION_CLASS = _FILE_INFORMATION_CLASS;
PFILE_INFORMATION_CLASS = ^FILE_INFORMATION_CLASS;
PFILE_BOTH_DIR_INFORMATION = ^FILE_BOTH_DIR_INFORMATION;
_FILE_BOTH_DIR_INFORMATION = Record
NextEntryOffset: ULONG;
FileIndex: ULONG;
CreationTime: LARGE_INTEGER;
LastAccessTime: LARGE_INTEGER;
LastWriteTime: LARGE_INTEGER;
ChangeTime: LARGE_INTEGER;
EndOfFile: LARGE_INTEGER;
AllocationSize: LARGE_INTEGER;
FileAttributes: ULONG;
FileNameLength: ULONG;
EaSize: ULONG;
ShortNameLength: CCHAR;
ShortName: array [0 .. 11] of WCHAR;
FileName: array [0 .. 0] of WCHAR;
end;
FILE_BOTH_DIR_INFORMATION = _FILE_BOTH_DIR_INFORMATION;
TFileBothDirInformation = FILE_BOTH_DIR_INFORMATION;
PFileBothDirInformation = PFILE_BOTH_DIR_INFORMATION;
function NT_SUCCESS(Status: NTSTATUS): boolean;
procedure InitializeObjectAttributes(p: POBJECT_ATTRIBUTES; n: PUNICODE_STRING;
a: ULONG; r: HANDLE; s: PVOID { PSECURITY_DESCRIPTOR } );
function NtCreateFile(FileHandle: PHANDLE; DesiredAccess: ACCESS_MASK;
ObjectAttributes: POBJECT_ATTRIBUTES; IoStatusBlock: PIO_STATUS_BLOCK;
AllocationSize: PLARGE_INTEGER; FileAttributes: ULONG; ShareAccess: ULONG;
CreateDisposition: ULONG; CreateOptions: ULONG; EaBuffer: PVOID;
EaLength: ULONG): NTSTATUS; stdcall;
function NtQueryDirectoryFile(FileHandle: HANDLE; Event: HANDLE;
ApcRoutine: PIO_APC_ROUTINE; ApcContext: PVOID;
IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: PVOID;
FileInformationLength: ULONG; FileInformationClass: FILE_INFORMATION_CLASS;
ReturnSingleEntry: ByteBool; FileName: PUNICODE_STRING; RestartScan: ByteBool)
: NTSTATUS; stdcall;
function NtCreateEvent(EventHandle: PHANDLE; DesiredAccess: ACCESS_MASK;
ObjectAttributes: POBJECT_ATTRIBUTES; EventType: EVENT_TYPE;
InitialState: ByteBool): NTSTATUS; stdcall;
function NtWaitForSingleObject(HANDLE: HANDLE; Alertable: ByteBool;
Timeout: PLARGE_INTEGER): NTSTATUS; stdcall;
procedure RtlInitUnicodeString(DestinationString: PUNICODE_STRING;
SourceString: LPCWSTR); stdcall;
function RtlUnicodeStringToAnsiString(DestinationString: PANSI_STRING;
SourceString: PUNICODE_STRING; AllocateDestinationString: ByteBool)
: NTSTATUS; stdcall;
implementation
function NT_SUCCESS(Status: NTSTATUS): boolean;
begin
result := Status >= 0
end;
procedure InitializeObjectAttributes(p: POBJECT_ATTRIBUTES; n: PUNICODE_STRING;
a: ULONG; r: HANDLE; s: PVOID { PSECURITY_DESCRIPTOR } );
begin
p^.Length := sizeof(OBJECT_ATTRIBUTES);
p^.RootDirectory := r;
p^.Attributes := a;
p^.ObjectName := n;
p^.SecurityDescriptor := s;
p^.SecurityQualityOfService := nil;
end;
function NtCreateFile; external ntdll name 'NtCreateFile';
function NtQueryDirectoryFile; external ntdll name 'NtQueryDirectoryFile';
function NtCreateEvent; external ntdll name 'NtCreateEvent';
function NtWaitForSingleObject; external ntdll name 'NtWaitForSingleObject';
procedure RtlInitUnicodeString; external ntdll name 'RtlInitUnicodeString';
function RtlUnicodeStringToAnsiString;
external ntdll name 'RtlUnicodeStringToAnsiString';
end.
برنامه :
program NativeFileListing;
{$APPTYPE CONSOLE}
uses
Windows,
NativeFileApi in 'NativeFileApi.pas';
// This simple test program demonstrates opening the root directory of the C:\ volume and enumerating its contents
//
// Contents provided by
// OSR Open Systems Resources, Inc.
//
// port by Krid
var
RootDirectoryName : UNICODE_STRING;
EntryName : UNICODE_STRING;
RootAnsiName : ANSI_STRING;
RootDirectoryAttributes: OBJECT_ATTRIBUTES;
Status : NTSTATUS;
RootDirectoryHandle : HANDLE;
Iosb: IO_STATUS_BLOCK;
Event : HANDLE;
Buffer:array [0..65535] of byte;
DirInformation : PFILE_BOTH_DIR_INFORMATION;
begin
// We use the name DosDevices rather than ?? so that it works on NT 3.51 as well as NT 4.0
RtlInitUnicodeString(@RootDirectoryName, '\DosDevices\C:\Windows\System32\');
// Now open it
InitializeObjectAttributes(@RootDirectoryAttribute s,
@RootDirectoryName,OBJ_CASE_INSENSITIVE,
0, // absolute open, no relative directory handle
nil); // no security descriptor necessary
Status := NtCreateFile(@RootDirectoryHandle,
GENERIC_READ,
@RootDirectoryAttributes,
@Iosb,
nil, // no meaning for allocation
FILE_ATTRIBUTE_DIRECTORY, // MUST be a directory
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, // share all
FILE_OPEN, // must already exist
FILE_DIRECTORY_FILE, // MUST be a directory
nil,
0);
if not NT_SUCCESS(Status) then
begin
writeln('Unable to open root directory, error =', Status);
halt(Status);
end;
// Create an event
Status:= NtCreateEvent (@Event,
GENERIC_ALL,
nil, // no object attributes
NotificationEvent,
FALSE);
if not NT_SUCCESS (Status) then
begin
writeln('Event creation failed with error =', Status);
halt(Status);
end;
// We pass NO NAME which is the same as *.*
Status := NtQueryDirectoryFile(RootDirectoryHandle,
Event,
nil, // No APC routine
nil, // No APC context
@ Iosb,
@ Buffer,
length (Buffer),
FileBothDirectoryInformation,
FALSE,
nil,
FALSE);
// If the directory operation is in progress, wait for it to finish.
if (Status = STATUS_PENDING) then
Status := NtWaitForSingleObject(Event, TRUE, nil);
// Check for errors.
if not NT_SUCCESS (Status) then
begin
writeln ('Unable to query directory contents, error =', Status);
halt (Status)
end;
// Note that as this is an example we're not ITERATING over the directory. To
// Do so we should use a loop and query the directory AGAIN until we get back
// STATUS_NO_MORE_FILES. If the directory was TOTALLY EMPTY we'd get back
// STATUS_NO_SUCH_FILE - but only the ROOT directory can ever be TOTALLY EMPTY.
DirInformation:= PFILE_BOTH_DIR_INFORMATION (@ Buffer);
writeln('File / Dir Name, Allocation_Size');
writeln('------------------------------'+ #13 + #10);
while true do
begin
EntryName.MaximumLength:= DirInformation^.FileNameLength;
EntryName.Length:= DirInformation^.FileNameLength;
EntryName.Buffer:= @DirInformation^.FileName;
RtlUnicodeStringToAnsiString (@RootAnsiName, @EntryName, TRUE);
// Dump the full name of the file. We could dump the other information
// Here as well, but we'll keep the example shorter instead.
writeln (RootAnsiName.Buffer, ',', DirInformation ^. AllocationSize.QuadPart);
// If there is no offset in the entry, the buffer has been exhausted.
if (DirInformation ^. NextEntryOffset = 0) then break else
begin
// Advance to the next entry.
DirInformation:= PFILE_BOTH_DIR_INFORMATION (Cardinal (DirInformation) + DirInformation ^. NextEntryOffset);
end;
end; // while
// Note that we skip closing our handles. The process death will do it for us.
Readln;
halt (STATUS_SUCCESS)
end.
منبع
نمونه برنامه دلفی برای ارتباط با درایور ها (سورسی که به زبان سی است:لبخند:) شامل متدهای زیر:
Registering the driver in the system
Dynamic loading driver
Dynamic unloading drivers
Removing the driver from the system
Calculation IOCTO code
and three methods of communication with the driver.
unit dDriver;
interface
uses Windows;
const
METHOD_BUFFERED = 0;
METHOD_NEITHER = 3;
FILE_ANY_ACCESS = 0;
FILE_READ_ACCESS = 1;
FILE_WRITE_ACCESS = 2;
FILE_DEVICE_UNKNOWN = $00000022;
Type
NTStatus = cardinal;
TString = array[0..MAX_PATH] of char;
PUnicodeString = ^TUnicodeString;
TUnicodeString = record
Length: WORD;
MaximumLength: WORD;
Buffer: PWideChar;
end;
const
STATUS_OBJECT_NAME_EXISTS = $40000000;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
DIRECTORY_TRAVERSE = $0002;
DIRECTORY_CREATE_OBJECT = $0004;
procedure RtlInitUnicodeString(DestinationString: PUnicodeString; SourceString: PWideChar);
stdcall; external 'ntdll.dll';
function ZwLoadDriver(DriverServiceName: PUnicodeString): cardinal;
stdcall;external 'ntdll.dll';
function ZwUnloadDriver(DriverServiceName: PUnicodeString): cardinal;
stdcall;external 'ntdll.dll';
type
TDriver = class
private
DrName: TString;
DrPath: TString;
hDriver: Cardinal;
RegisteredStatus,
LoadedStatus,
UnRegisteredStatus,
UnLoadStatus: boolean;
public
constructor Create(Name,Path: PCHAR); //??????? ??????-???????.???????? ???????,???? ? ????????
function Registered: boolean; //??????????? ???????? ? ???????. True - ?????
function Load: boolean; //???????????? ????????? ????????,True - ?????
function Start(Popitka:byte = 0):boolean; //???? ???? ???????? ??????? Registered,? ?????
//Load,?? ????? ??????? ????? Start.???????? ??????????? ??????? ???????? ????????
function UnLoad: boolean; //???????????? ?????????? ????????.True - ?????
function UnRegistered: boolean; //??????? ??????????? ???????? ?? ???????
function Stop:boolean; //????????? ??????? ? UnRegistered.
function IOCTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer; //???????? IOCTL ??????
function WriteToDriver(Var WriteBuf; SizeW: DWORD): integer; //?????? ????? ?? ????????,???????? WriteFile
function ReadFromDriver(Var ReadBuf; SizeR: DWORD): integer; //????? ????? ? ???????,????????? ReadFile
function ReadWrite(Var ToDroverBuf; SizeOfToDroverBuf: DWORD; CTL_CODE: DWORD; //????? ????? ? ????????? ? ???????? ??????.
Var FromDriverBuf; SizeOfFromDriverBuf: DWORD): Integer; //???????????? DeviceIOcontrol
property MyDriverName: TString read DrName; //???????? ???????? ???????
property MyDriverPath: TString read DrPath; //???? ? ????????
//property MyDriverHandle: Cardinal read hDriver; //???????? hDriver
property MyRegisteredStatus: boolean read RegisteredStatus; //???????
property MyLoadedStatus: boolean read LoadedStatus;
property MyUnRegisteredStatus: boolean read UnRegisteredStatus;
property MyUnLoadStatus: boolean read UnLoadStatus;
end;
implementation
const
DrvReg = '\registry\machine\system\CurrentControlSet\Servic es\';
function EnablePrivilegeEx(Process: dword; lpPrivilegeName: PChar):Boolean;
var
hToken: dword;
NameValue: Int64;
tkp: TOKEN_PRIVILEGES;
ReturnLength: dword;
begin
Result:=false;
OpenProcessToken(Process, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
if not LookupPrivilegeValue(nil, lpPrivilegeName, NameValue) then
begin
CloseHandle(hToken);
exit;
end;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := NameValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, false, tkp, SizeOf(TOKEN_PRIVILEGES), tkp, ReturnLength);
if GetLastError() <> ERROR_SUCCESS then
begin
CloseHandle(hToken);
exit;
end;
Result:=true;
CloseHandle(hToken);
end;
{ TDriver }
constructor TDriver.Create(Name, Path: PCHAR);
begin
inherited Create;
lStrCpy(DrName,Name);
lStrCpy(DrPath,Path);
RegisteredStatus:= False; LoadedStatus:= False;
UnRegisteredStatus:= False; UnLoadStatus:= False;
hDriver:=0;
//EnablePrivilegeEx(GetCurrentProcessId, 'SeLoadDriverPrivilege'); //SetDebugPrivileges
end;
function TDriver.Load: boolean;
var
Image: TUnicodeString;
Buff: array [0..MAX_PATH] of WideChar;
begin
StringToWideChar(DrvReg + DrName, Buff, MAX_PATH);
RtlInitUnicodeString(@Image, Buff);
Result := ZwLoadDriver(@Image) = 0;
LoadedStatus:= Result;
end;
function TDriver.Registered: boolean;
var
Key, Key2: HKEY;
dType: dword;
Err: dword;
NtPath: array[0..MAX_PATH] of Char;
begin
Result := false;
dType := 1;
Err := RegOpenKeyA(HKEY_LOCAL_MACHINE, 'system\CurrentControlSet\Services', Key);
if Err = ERROR_SUCCESS then
begin
Err := RegCreateKeyA(Key, drName, Key2);
if Err <> ERROR_SUCCESS then Err := RegOpenKeyA(Key, drName, Key2);
if Err = ERROR_SUCCESS then
begin
lstrcpy(NtPath, PChar('\??\' + drPath));
RegSetValueExA(Key2, 'ImagePath', 0, REG_SZ, @NtPath, lstrlen(NtPath));
RegSetValueExA(Key2, 'Type', 0, REG_DWORD, @dType, SizeOf(dword));
RegCloseKey(Key2);
Result := true;
end;
RegCloseKey(Key);
end;
RegisteredStatus:= Result;
end;
function TDriver.Start(Popitka:byte = 0):boolean;
Var F:Boolean;
i:byte;
Begin
F:=false;
i:=0;
repeat
F:=(Registered and Load);
if not F then
begin
UnLoad;
UnRegistered;
end;
inc(i);
if i = Popitka then
Break;
until F;
Result:=F;
End;
function TDriver.UnLoad: boolean;
var
Image: TUnicodeString;
Buff: array [0..MAX_PATH] of WideChar;
begin
StringToWideChar(DrvReg + DrName, Buff, MAX_PATH);
RtlInitUnicodeString(@Image, Buff);
Result := ZwUnloadDriver(@Image) = 0;
UnLoadStatus:= Result;
end;
function TDriver.UnRegistered: boolean;
var
Key: HKEY;
begin
Result := false;
if RegOpenKeyA(HKEY_LOCAL_MACHINE, 'system\CurrentControlSet\Services', Key) = ERROR_SUCCESS then
begin
RegDeleteKey(Key, PChar(drName+'\Enum'));
RegDeleteKey(Key, PChar(drName+'\Security'));
Result := RegDeleteKey(Key, drName) = ERROR_SUCCESS;
RegCloseKey(Key);
end;
UnRegisteredStatus:= Result;
end;
function TDriver.Stop:boolean;
Begin
Result:= UnLoad and UnRegistered;
End;
function TDriver.ReadFromDriver(var ReadBuf; SizeR: DWORD): integer;
Var H,N:Dword;
begin
ZeroMemory(@ReadBuf,SizeR);
Result:=Integer(LoadedStatus and RegisteredStatus);
if Result = 0 then
exit;
h:= CreateFile(PCHAR('\\.\'+DrName),GENERIC_ALL,0,nil, OPEN_EXISTING,0,0);
if h = INVALID_HANDLE_VALUE then
begin
Result:= -1;
exit;
end;
ReadFile(h,ReadBuf,SizeR,N,0);
Result:=N;
CloseHandle(h);
end;
function TDriver.WriteToDriver(var WriteBuf; SizeW: DWORD): integer;
Var H,N:Dword;
begin
Result:=Integer(LoadedStatus and RegisteredStatus);
if Result = 0 then exit;
h:= CreateFile(PCHAR('\\.\'+DrName),GENERIC_ALL,0,nil, OPEN_EXISTING,0,0);
if h = INVALID_HANDLE_VALUE then
begin
Result:= -1;
exit;
end;
WriteFile(h,WriteBuf,SizeW,N,0);
Result:=N;
CloseHandle(h);
end;
function TDriver.ReadWrite(Var ToDroverBuf; SizeOfToDroverBuf:
DWORD; CTL_CODE: DWORD;
Var FromDriverBuf; SizeOfFromDriverBuf: DWORD): Integer;
var
Bytes: dword;
begin
Result:= -1;
hDriver := CreateFile(pChar('\\.\'+DrName),GENERIC_ALL,0,nil, OPEN_EXISTING,0,0);
if hDriver = INVALID_HANDLE_VALUE then exit;
if @FromDriverBuf <> nil then ZeroMemory(@FromDriverBuf,SizeOfFromDriverBuf);
if DeviceIoControl(hDriver,
CTL_CODE,
@ToDroverBuf,SizeOfToDroverBuf, //??????,?????????? ? ???????
@FromDriverBuf, SizeOfFromDriverBuf, //??????,??????? ??????? ???????
Bytes, nil) then
Result:=Bytes;
CloseHandle(hDriver);
end;
function TDriver.IOCTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer;
begin
Result :=( (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or Method);
end;
end.
program DriverLoader;
{$Apptype Console}
uses
windows,dDriver,SysUtils;
Var
Name,Path:String;
Driver: TDriver;
DataToDriver,DataFromDriver:Array[0..19] of char;
CTL:DWORD;
begin
Name:= 'Share';
Path:='D:\Sniffer\Share\i386\Share.sys';
WriteLn('Name: ',Name);
WriteLn('Path: ',Path);
Driver:= TDriver.Create(pChar(Name),pChar(Path));
{if Driver.Registered then
WriteLn('Registered!') else
WriteLn('Not Registered!');
if Driver.Load then
WriteLn('Loaded!') else
WriteLn('Not Loaded!');}
Driver.Start(3);
CTL:=Driver.IOCTL_CODE(FILE_DEVICE_UNKNOWN,$803,ME THOD_BUFFERED,FILE_ANY_ACCESS);
//???????? ???????? ???????? Hellow...
DataToDriver:='Project1.exe';
Driver.WriteToDriver(DataToDriver,Length(DataToDri ver));
//????????? ???????? ?? ???????? Hellow.
Driver.ReadFromDriver(DataFromDriver,SizeOf(DataFr omDriver));
WriteLn(DataFromDriver);
//????????? ? ?? ? ??
FillChar(DataToDriver,0,SizeOf(DataToDriver)); FillChar(DataFromDriver,0,SizeOf(DataFromDriver));
DataToDriver:='Hellow against!';
Driver.ReadWrite(DataToDriver,SizeOf(DataToDriver) ,CTL,DataFromDriver,SizeOf(DataToDriver));
WriteLn(DataFromDriver);
{if Driver.UnLoad then
WriteLn('UnLoad!') else
WriteLn('Not UnLoad!');
if Driver.UnRegistered then
WriteLn('UnRegistered!') else
WriteLn('Not UnRegistered!');}
Driver.Stop;
ReadLn;
end.
#include "ntddk.h"
#define NT_DEVICE_NAME L"\\Device\\Share"
#define WIN32_DEVICE_NAME L"\\DosDevices\\SHare"
#define DWORD unsigned long
#define SECTION_SIZE 255
#define IOCTL_SHARE CTL_CODE (FILE_DEVICE_UNKNOWN, 0x803, METHOD_BUFFERED, FILE_ANY_ACCESS)
NTSTATUS CtlCreate(IN PDEVICE_OBJECT, IN PIRP);
NTSTATUS CtlClose(IN PDEVICE_OBJECT, IN PIRP);
NTSTATUS CtlDriverDispatch(IN PDEVICE_OBJECT DeviceObject, IN PIRP Irp);
NTSTATUS CtlDriverDispatchWrite(IN PDEVICE_OBJECT,IN PIRP); //???? ?????????? ????? WriteFile
NTSTATUS CtlDriverDispatchRead(IN PDEVICE_OBJECT,IN PIRP); //???? ?????????? ????? ReadFile
NTSTATUS UnloadDriver(IN PDRIVER_OBJECT pDriverObject); //???? ?????????? ????? DeviceIOControl
NTSTATUS DriverEntry(IN PDRIVER_OBJECT pDriverObject, IN PUNICODE_STRING RegistryPath)
{
PDEVICE_OBJECT pDeviceObject;
UNICODE_STRING uniNtName;
UNICODE_STRING uniWin32Name;
RtlInitUnicodeString(&uniNtName, NT_DEVICE_NAME);
RtlInitUnicodeString(&uniWin32Name, WIN32_DEVICE_NAME);
IoCreateSymbolicLink(&uniWin32Name, &uniNtName);
IoCreateDevice(pDriverObject,0,&uniNtName,FILE_DEV ICE_UNKNOWN,0,FALSE,&pDeviceObject);
pDriverObject->MajorFunction[IRP_MJ_CREATE]=CtlCreate;
pDriverObject->MajorFunction[IRP_MJ_CLOSE]=CtlClose;
pDriverObject->MajorFunction[IRP_MJ_DEVICE_CONTROL]=CtlDriverDispatch;
pDriverObject->MajorFunction[IRP_MJ_WRITE] = CtlDriverDispatchWrite;
pDriverObject->MajorFunction[IRP_MJ_READ] = CtlDriverDispatchRead;
pDriverObject->DriverUnload = UnloadDriver;
DbgPrint("Driver has been loaded!");
return STATUS_SUCCESS;
}
NTSTATUS CtlCreate(IN PDEVICE_OBJECT pDeviceObject,IN PIRP Irp)
{
Irp->IoStatus.Status=STATUS_SUCCESS;
Irp->IoStatus.Information=0;
IoCompleteRequest(Irp,IO_NO_INCREMENT);
return STATUS_SUCCESS;
}
NTSTATUS CtlClose(IN PDEVICE_OBJECT pDeviceObject,IN PIRP Irp)
{
Irp->IoStatus.Status=STATUS_SUCCESS;
Irp->IoStatus.Information=0;
IoCompleteRequest(Irp,IO_NO_INCREMENT);
return STATUS_SUCCESS;
}
NTSTATUS UnloadDriver(IN PDRIVER_OBJECT pDriverObject)
{
PDEVICE_OBJECT deviceObject = pDriverObject->DeviceObject;
UNICODE_STRING uniWin32NameString;
RtlInitUnicodeString( &uniWin32NameString, WIN32_DEVICE_NAME );
IoDeleteSymbolicLink( &uniWin32NameString );
IoDeleteDevice( deviceObject );
DbgPrint("Driver has been Unloaded!");
return STATUS_SUCCESS;
}
NTSTATUS CtlDriverDispatchWrite(IN PDEVICE_OBJECT pDeviceObject,IN PIRP Irp)
{
//? Irp->UserBuffer ????? ??,??? ?????? ???????????? WriteFile??
PIO_STACK_LOCATION pIrpStack;
pIrpStack=IoGetCurrentIrpStackLocation(Irp);
Irp->IoStatus.Information = 0;
if (pIrpStack->MajorFunction == IRP_MJ_WRITE)
{
__try
{
ULONG Length = pIrpStack->Parameters.Write.Length;
DbgPrint("Recv:%s \n",Irp->UserBuffer);
}
__except(EXCEPTION_EXECUTE_HANDLER)
{
DbgPrint("Error");
}
}
Irp->IoStatus.Status=STATUS_SUCCESS;
IoCompleteRequest (Irp,IO_NO_INCREMENT);
return STATUS_SUCCESS;
}
NTSTATUS CtlDriverDispatchRead(IN PDEVICE_OBJECT pDeviceObject,IN PIRP Irp)
{
//???? ???????? ? Irp->UserBuffer ??,????????? ? ?????,??????? ????? ? ReadFile ?? ??????????
PIO_STACK_LOCATION pIrpStack;
pIrpStack=IoGetCurrentIrpStackLocation(Irp);
DbgPrint("CtlDriverDispatchRead");
if (pIrpStack->MajorFunction == IRP_MJ_READ)
{
__try
{
RtlCopyMemory(Irp->UserBuffer,"Hellow!FromDrover",18);
}
__except(EXCEPTION_EXECUTE_HANDLER)
{
DbgPrint("Error");
}
}
Irp->IoStatus.Information = 0;
Irp->IoStatus.Status=STATUS_SUCCESS;
IoCompleteRequest (Irp,IO_NO_INCREMENT);
return STATUS_SUCCESS;
}
NTSTATUS CtlDriverDispatch(IN PDEVICE_OBJECT pDeviceObject,IN PIRP Irp)
{
//? ?????? ?????? ??????? ????? ????? Irp->AssociatedIrp.SystemBuffer ???.
PIO_STACK_LOCATION pIrpStack;
PVOID pBuff = Irp->UserBuffer; //?????? ? ?????
PVOID pBuff_In = Irp->AssociatedIrp.SystemBuffer; //????? ?? ?????
DWORD *Pid = NULL;
DWORD PID = 0;
pIrpStack=IoGetCurrentIrpStackLocation(Irp);
DbgPrint("CtlDriverDispatch...\n");
DbgPrint("CTL: %d",IOCTL_SHARE);
if (pIrpStack->Parameters.DeviceIoControl.IoControlCode == IOCTL_SHARE)// ???? ????? IOCTL ??????,??
{//?????? ???.
__try
{
DbgPrint("We are in SEH mdoe!\n");
Pid = pBuff_In;
DbgPrint("RECV %s \n",pBuff_In);
RtlCopyMemory(pBuff,"12345",5);
DbgPrint("Sended: %s","12345");
}
__except(EXCEPTION_EXECUTE_HANDLER)
{
DbgPrint("Error");
}
}
Irp->IoStatus.Information = 0;
Irp->IoStatus.Status=STATUS_SUCCESS;
IoCompleteRequest (Irp,IO_NO_INCREMENT);
return STATUS_SUCCESS;
}
من اینو تست نکردم (مال خودم رو دارم:بامزه:)
منبع برادران روس
شب خوش
ممکنه در برخی شرایط خاص بخواهید اندازه یک تابع رو به دست بیارید در این صورت می تونید از یونیت زیر استفاده کنید (مثلاً: Injection :شیطان:)
{
---------------------------------------------------
Opcode Length Disassembler.
Coded By Ms-Rem ( Ms-Rem@yandex.ru ) ICQ 286370715
---------------------------------------------------
12.08.2005 - fixed many bugs...
09.08.2005 - fixed bug with 0F BA opcode.
07.08.2005 - added SSE, SSE2, SSE3 and 3Dnow instruction support.
06.08.2005 - fixed bug with F6 and F7 opcodes.
29.07.2005 - fixed bug with OP_WORD opcodes.
}
unit LDasm;
interface
type
dword = cardinal;
ppbyte = ^pbyte;
function SizeOfCode(Code: pointer; pOpcode: ppbyte): dword;
function SizeOfProc(Proc: pointer): dword;
function IsRelativeCmd(pOpcode: pbyte): boolean;
implementation
const
OP_NONE = $00;
OP_MODRM = $01;
OP_DATA_I8 = $02;
OP_DATA_I16 = $04;
OP_DATA_I32 = $08;
OP_DATA_PRE66_67 = $10;
OP_WORD = $20;
OP_REL32 = $40;
const
OpcodeFlags: array [$00..$FF] of byte =
(
OP_MODRM, // 00
OP_MODRM, // 01
OP_MODRM, // 02
OP_MODRM, // 03
OP_DATA_I8, // 04
OP_DATA_PRE66_67, // 05
OP_NONE, // 06
OP_NONE, // 07
OP_MODRM, // 08
OP_MODRM, // 09
OP_MODRM, // 0A
OP_MODRM, // 0B
OP_DATA_I8, // 0C
OP_DATA_PRE66_67, // 0D
OP_NONE, // 0E
OP_NONE, // 0F
OP_MODRM, // 10
OP_MODRM, // 11
OP_MODRM, // 12
OP_MODRM, // 13
OP_DATA_I8, // 14
OP_DATA_PRE66_67, // 15
OP_NONE, // 16
OP_NONE, // 17
OP_MODRM, // 18
OP_MODRM, // 19
OP_MODRM, // 1A
OP_MODRM, // 1B
OP_DATA_I8, // 1C
OP_DATA_PRE66_67, // 1D
OP_NONE, // 1E
OP_NONE, // 1F
OP_MODRM, // 20
OP_MODRM, // 21
OP_MODRM, // 22
OP_MODRM, // 23
OP_DATA_I8, // 24
OP_DATA_PRE66_67, // 25
OP_NONE, // 26
OP_NONE, // 27
OP_MODRM, // 28
OP_MODRM, // 29
OP_MODRM, // 2A
OP_MODRM, // 2B
OP_DATA_I8, // 2C
OP_DATA_PRE66_67, // 2D
OP_NONE, // 2E
OP_NONE, // 2F
OP_MODRM, // 30
OP_MODRM, // 31
OP_MODRM, // 32
OP_MODRM, // 33
OP_DATA_I8, // 34
OP_DATA_PRE66_67, // 35
OP_NONE, // 36
OP_NONE, // 37
OP_MODRM, // 38
OP_MODRM, // 39
OP_MODRM, // 3A
OP_MODRM, // 3B
OP_DATA_I8, // 3C
OP_DATA_PRE66_67, // 3D
OP_NONE, // 3E
OP_NONE, // 3F
OP_NONE, // 40
OP_NONE, // 41
OP_NONE, // 42
OP_NONE, // 43
OP_NONE, // 44
OP_NONE, // 45
OP_NONE, // 46
OP_NONE, // 47
OP_NONE, // 48
OP_NONE, // 49
OP_NONE, // 4A
OP_NONE, // 4B
OP_NONE, // 4C
OP_NONE, // 4D
OP_NONE, // 4E
OP_NONE, // 4F
OP_NONE, // 50
OP_NONE, // 51
OP_NONE, // 52
OP_NONE, // 53
OP_NONE, // 54
OP_NONE, // 55
OP_NONE, // 56
OP_NONE, // 57
OP_NONE, // 58
OP_NONE, // 59
OP_NONE, // 5A
OP_NONE, // 5B
OP_NONE, // 5C
OP_NONE, // 5D
OP_NONE, // 5E
OP_NONE, // 5F
OP_NONE, // 60
OP_NONE, // 61
OP_MODRM, // 62
OP_MODRM, // 63
OP_NONE, // 64
OP_NONE, // 65
OP_NONE, // 66
OP_NONE, // 67
OP_DATA_PRE66_67, // 68
OP_MODRM or OP_DATA_PRE66_67, // 69
OP_DATA_I8, // 6A
OP_MODRM or OP_DATA_I8, // 6B
OP_NONE, // 6C
OP_NONE, // 6D
OP_NONE, // 6E
OP_NONE, // 6F
OP_DATA_I8, // 70
OP_DATA_I8, // 71
OP_DATA_I8, // 72
OP_DATA_I8, // 73
OP_DATA_I8, // 74
OP_DATA_I8, // 75
OP_DATA_I8, // 76
OP_DATA_I8, // 77
OP_DATA_I8, // 78
OP_DATA_I8, // 79
OP_DATA_I8, // 7A
OP_DATA_I8, // 7B
OP_DATA_I8, // 7C
OP_DATA_I8, // 7D
OP_DATA_I8, // 7E
OP_DATA_I8, // 7F
OP_MODRM or OP_DATA_I8, // 80
OP_MODRM or OP_DATA_PRE66_67, // 81
OP_MODRM or OP_DATA_I8, // 82
OP_MODRM or OP_DATA_I8, // 83
OP_MODRM, // 84
OP_MODRM, // 85
OP_MODRM, // 86
OP_MODRM, // 87
OP_MODRM, // 88
OP_MODRM, // 89
OP_MODRM, // 8A
OP_MODRM, // 8B
OP_MODRM, // 8C
OP_MODRM, // 8D
OP_MODRM, // 8E
OP_MODRM, // 8F
OP_NONE, // 90
OP_NONE, // 91
OP_NONE, // 92
OP_NONE, // 93
OP_NONE, // 94
OP_NONE, // 95
OP_NONE, // 96
OP_NONE, // 97
OP_NONE, // 98
OP_NONE, // 99
OP_DATA_I16 or OP_DATA_PRE66_67, // 9A
OP_NONE, // 9B
OP_NONE, // 9C
OP_NONE, // 9D
OP_NONE, // 9E
OP_NONE, // 9F
OP_DATA_PRE66_67, // A0
OP_DATA_PRE66_67, // A1
OP_DATA_PRE66_67, // A2
OP_DATA_PRE66_67, // A3
OP_NONE, // A4
OP_NONE, // A5
OP_NONE, // A6
OP_NONE, // A7
OP_DATA_I8, // A8
OP_DATA_PRE66_67, // A9
OP_NONE, // AA
OP_NONE, // AB
OP_NONE, // AC
OP_NONE, // AD
OP_NONE, // AE
OP_NONE, // AF
OP_DATA_I8, // B0
OP_DATA_I8, // B1
OP_DATA_I8, // B2
OP_DATA_I8, // B3
OP_DATA_I8, // B4
OP_DATA_I8, // B5
OP_DATA_I8, // B6
OP_DATA_I8, // B7
OP_DATA_PRE66_67, // B8
OP_DATA_PRE66_67, // B9
OP_DATA_PRE66_67, // BA
OP_DATA_PRE66_67, // BB
OP_DATA_PRE66_67, // BC
OP_DATA_PRE66_67, // BD
OP_DATA_PRE66_67, // BE
OP_DATA_PRE66_67, // BF
OP_MODRM or OP_DATA_I8, // C0
OP_MODRM or OP_DATA_I8, // C1
OP_DATA_I16, // C2
OP_NONE, // C3
OP_MODRM, // C4
OP_MODRM, // C5
OP_MODRM or OP_DATA_I8, // C6
OP_MODRM or OP_DATA_PRE66_67, // C7
OP_DATA_I8 or OP_DATA_I16, // C8
OP_NONE, // C9
OP_DATA_I16, // CA
OP_NONE, // CB
OP_NONE, // CC
OP_DATA_I8, // CD
OP_NONE, // CE
OP_NONE, // CF
OP_MODRM, // D0
OP_MODRM, // D1
OP_MODRM, // D2
OP_MODRM, // D3
OP_DATA_I8, // D4
OP_DATA_I8, // D5
OP_NONE, // D6
OP_NONE, // D7
OP_WORD, // D8
OP_WORD, // D9
OP_WORD, // DA
OP_WORD, // DB
OP_WORD, // DC
OP_WORD, // DD
OP_WORD, // DE
OP_WORD, // DF
OP_DATA_I8, // E0
OP_DATA_I8, // E1
OP_DATA_I8, // E2
OP_DATA_I8, // E3
OP_DATA_I8, // E4
OP_DATA_I8, // E5
OP_DATA_I8, // E6
OP_DATA_I8, // E7
OP_DATA_PRE66_67 or OP_REL32, // E8
OP_DATA_PRE66_67 or OP_REL32, // E9
OP_DATA_I16 or OP_DATA_PRE66_67, // EA
OP_DATA_I8, // EB
OP_NONE, // EC
OP_NONE, // ED
OP_NONE, // EE
OP_NONE, // EF
OP_NONE, // F0
OP_NONE, // F1
OP_NONE, // F2
OP_NONE, // F3
OP_NONE, // F4
OP_NONE, // F5
OP_MODRM, // F6
OP_MODRM, // F7
OP_NONE, // F8
OP_NONE, // F9
OP_NONE, // FA
OP_NONE, // FB
OP_NONE, // FC
OP_NONE, // FD
OP_MODRM, // FE
OP_MODRM or OP_REL32 // FF
);
OpcodeFlagsExt: array [$00..$FF] of byte =
(
OP_MODRM, // 00
OP_MODRM, // 01
OP_MODRM, // 02
OP_MODRM, // 03
OP_NONE, // 04
OP_NONE, // 05
OP_NONE, // 06
OP_NONE, // 07
OP_NONE, // 08
OP_NONE, // 09
OP_NONE, // 0A
OP_NONE, // 0B
OP_NONE, // 0C
OP_MODRM, // 0D
OP_NONE, // 0E
OP_MODRM or OP_DATA_I8, // 0F
OP_MODRM, // 10
OP_MODRM, // 11
OP_MODRM, // 12
OP_MODRM, // 13
OP_MODRM, // 14
OP_MODRM, // 15
OP_MODRM, // 16
OP_MODRM, // 17
OP_MODRM, // 18
OP_NONE, // 19
OP_NONE, // 1A
OP_NONE, // 1B
OP_NONE, // 1C
OP_NONE, // 1D
OP_NONE, // 1E
OP_NONE, // 1F
OP_MODRM, // 20
OP_MODRM, // 21
OP_MODRM, // 22
OP_MODRM, // 23
OP_MODRM, // 24
OP_NONE, // 25
OP_MODRM, // 26
OP_NONE, // 27
OP_MODRM, // 28
OP_MODRM, // 29
OP_MODRM, // 2A
OP_MODRM, // 2B
OP_MODRM, // 2C
OP_MODRM, // 2D
OP_MODRM, // 2E
OP_MODRM, // 2F
OP_NONE, // 30
OP_NONE, // 31
OP_NONE, // 32
OP_NONE, // 33
OP_NONE, // 34
OP_NONE, // 35
OP_NONE, // 36
OP_NONE, // 37
OP_NONE, // 38
OP_NONE, // 39
OP_NONE, // 3A
OP_NONE, // 3B
OP_NONE, // 3C
OP_NONE, // 3D
OP_NONE, // 3E
OP_NONE, // 3F
OP_MODRM, // 40
OP_MODRM, // 41
OP_MODRM, // 42
OP_MODRM, // 43
OP_MODRM, // 44
OP_MODRM, // 45
OP_MODRM, // 46
OP_MODRM, // 47
OP_MODRM, // 48
OP_MODRM, // 49
OP_MODRM, // 4A
OP_MODRM, // 4B
OP_MODRM, // 4C
OP_MODRM, // 4D
OP_MODRM, // 4E
OP_MODRM, // 4F
OP_MODRM, // 50
OP_MODRM, // 51
OP_MODRM, // 52
OP_MODRM, // 53
OP_MODRM, // 54
OP_MODRM, // 55
OP_MODRM, // 56
OP_MODRM, // 57
OP_MODRM, // 58
OP_MODRM, // 59
OP_MODRM, // 5A
OP_MODRM, // 5B
OP_MODRM, // 5C
OP_MODRM, // 5D
OP_MODRM, // 5E
OP_MODRM, // 5F
OP_MODRM, // 60
OP_MODRM, // 61
OP_MODRM, // 62
OP_MODRM, // 63
OP_MODRM, // 64
OP_MODRM, // 65
OP_MODRM, // 66
OP_MODRM, // 67
OP_MODRM, // 68
OP_MODRM, // 69
OP_MODRM, // 6A
OP_MODRM, // 6B
OP_MODRM, // 6C
OP_MODRM, // 6D
OP_MODRM, // 6E
OP_MODRM, // 6F
OP_MODRM or OP_DATA_I8, // 70
OP_MODRM or OP_DATA_I8, // 71
OP_MODRM or OP_DATA_I8, // 72
OP_MODRM or OP_DATA_I8, // 73
OP_MODRM, // 74
OP_MODRM, // 75
OP_MODRM, // 76
OP_NONE, // 77
OP_NONE, // 78
OP_NONE, // 79
OP_NONE, // 7A
OP_NONE, // 7B
OP_MODRM, // 7C
OP_MODRM, // 7D
OP_MODRM, // 7E
OP_MODRM, // 7F
OP_DATA_PRE66_67 or OP_REL32, // 80
OP_DATA_PRE66_67 or OP_REL32, // 81
OP_DATA_PRE66_67 or OP_REL32, // 82
OP_DATA_PRE66_67 or OP_REL32, // 83
OP_DATA_PRE66_67 or OP_REL32, // 84
OP_DATA_PRE66_67 or OP_REL32, // 85
OP_DATA_PRE66_67 or OP_REL32, // 86
OP_DATA_PRE66_67 or OP_REL32, // 87
OP_DATA_PRE66_67 or OP_REL32, // 88
OP_DATA_PRE66_67 or OP_REL32, // 89
OP_DATA_PRE66_67 or OP_REL32, // 8A
OP_DATA_PRE66_67 or OP_REL32, // 8B
OP_DATA_PRE66_67 or OP_REL32, // 8C
OP_DATA_PRE66_67 or OP_REL32, // 8D
OP_DATA_PRE66_67 or OP_REL32, // 8E
OP_DATA_PRE66_67 or OP_REL32, // 8F
OP_MODRM, // 90
OP_MODRM, // 91
OP_MODRM, // 92
OP_MODRM, // 93
OP_MODRM, // 94
OP_MODRM, // 95
OP_MODRM, // 96
OP_MODRM, // 97
OP_MODRM, // 98
OP_MODRM, // 99
OP_MODRM, // 9A
OP_MODRM, // 9B
OP_MODRM, // 9C
OP_MODRM, // 9D
OP_MODRM, // 9E
OP_MODRM, // 9F
OP_NONE, // A0
OP_NONE, // A1
OP_NONE, // A2
OP_MODRM, // A3
OP_MODRM or OP_DATA_I8, // A4
OP_MODRM, // A5
OP_NONE, // A6
OP_NONE, // A7
OP_NONE, // A8
OP_NONE, // A9
OP_NONE, // AA
OP_MODRM, // AB
OP_MODRM or OP_DATA_I8, // AC
OP_MODRM, // AD
OP_MODRM, // AE
OP_MODRM, // AF
OP_MODRM, // B0
OP_MODRM, // B1
OP_MODRM, // B2
OP_MODRM, // B3
OP_MODRM, // B4
OP_MODRM, // B5
OP_MODRM, // B6
OP_MODRM, // B7
OP_NONE, // B8
OP_NONE, // B9
OP_MODRM or OP_DATA_I8, // BA
OP_MODRM, // BB
OP_MODRM, // BC
OP_MODRM, // BD
OP_MODRM, // BE
OP_MODRM, // BF
OP_MODRM, // C0
OP_MODRM, // C1
OP_MODRM or OP_DATA_I8, // C2
OP_MODRM, // C3
OP_MODRM or OP_DATA_I8, // C4
OP_MODRM or OP_DATA_I8, // C5
OP_MODRM or OP_DATA_I8, // C6
OP_MODRM, // C7
OP_NONE, // C8
OP_NONE, // C9
OP_NONE, // CA
OP_NONE, // CB
OP_NONE, // CC
OP_NONE, // CD
OP_NONE, // CE
OP_NONE, // CF
OP_MODRM, // D0
OP_MODRM, // D1
OP_MODRM, // D2
OP_MODRM, // D3
OP_MODRM, // D4
OP_MODRM, // D5
OP_MODRM, // D6
OP_MODRM, // D7
OP_MODRM, // D8
OP_MODRM, // D9
OP_MODRM, // DA
OP_MODRM, // DB
OP_MODRM, // DC
OP_MODRM, // DD
OP_MODRM, // DE
OP_MODRM, // DF
OP_MODRM, // E0
OP_MODRM, // E1
OP_MODRM, // E2
OP_MODRM, // E3
OP_MODRM, // E4
OP_MODRM, // E5
OP_MODRM, // E6
OP_MODRM, // E7
OP_MODRM, // E8
OP_MODRM, // E9
OP_MODRM, // EA
OP_MODRM, // EB
OP_MODRM, // EC
OP_MODRM, // ED
OP_MODRM, // EE
OP_MODRM, // EF
OP_MODRM, // F0
OP_MODRM, // F1
OP_MODRM, // F2
OP_MODRM, // F3
OP_MODRM, // F4
OP_MODRM, // F5
OP_MODRM, // F6
OP_MODRM, // F7
OP_MODRM, // F8
OP_MODRM, // F9
OP_MODRM, // FA
OP_MODRM, // FB
OP_MODRM, // FC
OP_MODRM, // FD
OP_MODRM, // FE
OP_NONE // FF
);
{دîëَ÷هيèه ïîëيîمî ًàçىهًà ىàّèييîé êîىىàينû ïî َêàçàٍهë يà يهه }
function SizeOfCode(Code: pointer; pOpcode: ppbyte): dword;
var
cPtr: pbyte;
Flags: byte;
PFX66, PFX67: boolean;
SibPresent: boolean;
iMod, iRM, iReg: byte;
OffsetSize, Add: byte;
Opcode: byte;
begin
Result := 0;
OffsetSize := 0;
PFX66 := false;
PFX67 := false;
cPtr := Code;
{îïًهنهëےهى ًàçىهً ïًهôôèêٌîâ}
while cPtr^ in [$2E, $3E, $36, $26, $64, $65, $F0, $F2, $F3, $66, $67] do
begin
if cPtr^ = $66 then PFX66 := true;
if cPtr^ = $67 then PFX67 := true;
Inc(cPtr);
if dword(cPtr) > dword(Code) + 16 then Exit;
end;
Opcode := cPtr^;
if pOpcode <> nil then pOpcode^ := cPtr;
{îïًهنهëےهى ًàçىهً îïêîنà è ïîëَ÷àهى ôëàمè}
if cPtr^ = $0F then
begin
Inc(cPtr);
Flags := OpcodeFlagsExt[cPtr^];
end else
begin
Flags := OpcodeFlags[Opcode];
if Opcode in [$A0..$A3] then PFX66 := PFX67;
end;
Inc(cPtr);
if (Flags and OP_WORD) > 0 then Inc(cPtr);
{îلًàلàٍûâàهى MOD r/m}
if (Flags and OP_MODRM) > 0 then
begin
iMod := cPtr^ shr 6;
iReg := (cPtr^ and $38) shr 3;
iRM := cPtr^ and 7;
Inc(cPtr);
{îïêîنû F6 è F7 - Immediate ïًèٌٌٍٍَâَهٍ ٍîëüêî ïًè iReg = 0}
if (Opcode = $F6) and (iReg = 0) then Flags := Flags or OP_DATA_I8;
if (Opcode = $F7) and (iReg = 0) then Flags := Flags or OP_DATA_PRE66_67;
{îلًàلàٍûâàهى SIB è Offset}
SibPresent := (not PFX67) and (iRM = 4);
case iMod of
0: begin
if PFX67 and (iRM = 6) then OffsetSize := 2;
if (not PFX67) and (iRM = 5) then OffsetSize := 4;
end;
1: OffsetSize := 1;
2: if PFX67 then OffsetSize := 2 else OffsetSize := 4;
3: SibPresent := false;
end;
if SibPresent then
begin
if (cPtr^ and 7 = 5) and (iMod in [0, 2]) then OffsetSize := 4;
Inc(cPtr);
end;
Inc(cPtr, OffsetSize);
end;
{îلًàلàٍûâàهى IMM çيà÷هيèے}
if (Flags and OP_DATA_I8) > 0 then Inc(cPtr);
if (Flags and OP_DATA_I16) > 0 then Inc(cPtr, 2);
if (Flags and OP_DATA_I32) > 0 then Inc(cPtr, 4);
if PFX66 then Add := 2 else Add := 4;
if (Flags and OP_DATA_PRE66_67) > 0 then Inc(cPtr, Add);
Result := dword(cPtr) - dword(Code);
end;
{ دîëَ÷هيèه ًàçىهًà ôَيêِèè ïî َêàçàٍهë يà يهه (ًàçىهً نî ïهًâîé êîىىàينû RET) }
function SizeOfProc(Proc: pointer): dword;
var
Length: dword;
pOpcode: pbyte;
begin
Result := 0;
repeat
Length := SizeOfCode(Proc, @pOpcode);
Inc(Result, Length);
if (Length = 1) and (pOpcode^ = $C3) then Break;
Proc := pointer(dword(Proc) + Length);
until Length = 0;
end;
{îïًهنهëهيèه ٍîمî, èىههٍ ëè êîىىàينà rel32 offset}
function IsRelativeCmd(pOpcode: pbyte): boolean;
var
Flags: byte;
begin
if pOpcode^ = $0F then Flags := OpcodeFlagsExt[pbyte(dword(pOpcode) + 1)^]
else Flags := OpcodeFlags[pOpcode^];
Result := Flags and OP_REL32 > 0;
end;
end.
مثال:
procedure MSGBOX;
begin
ShowMessage('hello');
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
ShowMessage(IntToStr(SizeOfProc(@MSGBOX)));
end;
:ناراحت:
شاید یه روزی بخوایید تمام رشته های موجود توی یه فایل exe رو به دست بیارید خب این توابع بهتون کمک میکنه
اولی توی کل فایل و دومی فقط سکشن ها رو می گرده
تشکر از عمو steve :لبخند:
{steve10120@ic0de.org}
function FileToPtr(szFilePath: string; var pFile: Pointer;
var dwFileSize: DWORD): Boolean;
var
hFile: DWORD;
dwRead: DWORD;
begin
Result := FALSE;
hFile := CreateFile(PChar(szFilePath), GENERIC_READ, 0, nil,
OPEN_EXISTING, 0, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
dwFileSize := GetFileSize(hFile, nil);
if (dwFileSize > 0) then
begin
pFile := VirtualAlloc(nil, dwFileSize, MEM_COMMIT, PAGE_READWRITE);
if (Assigned(pFile)) then
begin
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
ReadFile(hFile, pFile^, dwFileSize, dwRead, nil);
if (dwRead = dwFileSize) then
Result := TRUE;
end;
end;
CloseHandle(hFile);
end;
end;
function FindASCIIStringsA(szFilePath: string; dwMinLength: DWORD;
szDumpPath: string): Boolean;
var
pFile: Pointer;
dwFileSize: DWORD;
i: DWORD;
szDump: string;
dwLength: DWORD;
hFile: TextFile;
begin
Result := FALSE;
if (FileToPtr(szFilePath, pFile, dwFileSize)) then
begin
dwLength := 0;
AssignFile(hFile, szDumpPath);
// yeah I don't like it but its easiest for writing lines..
Rewrite(hFile);
for i := 0 to (dwFileSize - 1) do
begin
if (PByte(DWORD(pFile) + i)^ in [$20 .. $7E]) then
begin
szDump := szDump + Char(PByte(DWORD(pFile) + i)^);
// WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);
Inc(dwLength);
end
else
begin
if (dwLength >= dwMinLength) then
WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);
dwLength := 0;
szDump := '';
end;
end;
if (FileSize(hFile) > 0) then
Result := TRUE;
CloseFile(hFile);
VirtualFree(pFile, 0, MEM_RELEASE);
end;
end;
function FindASCIIStrings(szFilePath:string; dwMinLength:DWORD; szDumpPath:string):Boolean;
var
pFile: Pointer;
dwFileSize: DWORD;
IDH: PImageDosHeader;
INH: PImageNtHeaders;
i: DWORD;
szDump: string;
dwLength: DWORD;
hFile: TextFile;
begin
Result := FALSE;
if (FileToPtr(szFilePath, pFile, dwFileSize)) then
begin
IDH := pFile;
if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then
begin
INH := Pointer(DWORD(pFile) + IDH^._lfanew);
if (INH^.Signature = IMAGE_NT_SIGNATURE) then
begin
dwLength := 0;
AssignFile(hFile, szDumpPath); // yeah I don't like it but its easiest for writing lines..
Rewrite(hFile);
for i := INH^.OptionalHeader.SizeOfHeaders to (dwFileSize - 1) do
begin
if (PByte(DWORD(pFile) + i)^ in [$20..$7E]) then
begin
szDump := szDump + Char(PByte(DWORD(pFile) + i)^);
Inc(dwLength);
end
else
begin
if (dwLength >= dwMinLength) then
WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);
dwLength := 0;
szDump := '';
end;
end;
if (FileSize(hFile) > 0) then
Result := TRUE;
CloseFile(hFile);
end;
end;
VirtualFree(pFile, 0, MEM_RELEASE);
end;
end;
procedure TForm2.btn1Click(Sender: TObject);
begin
FindASCIIStrings('e:\AntiDebugg.exe', 2,
IncludeTrailingPathDelimiter(ExtractFilePath(param str(0))) +
ExtractFileName(paramstr(1)) + '.dmp')
end;
جدا کردن سه رقم در حین ورود ارقام. (مثل حالت Digit Grouping در ماشین حساب ویندوز)
procedure TFrmIns.EdtPriceChange(Sender: TObject);
begin
if (Trim(EdtPrice.Text) = '') then Exit;
EdtPrice.Text:= FormatFloat(',###.##', StrToFloat(ReplaceStr(EdtPrice.Text,
',', '')));
EdtPrice.SelStart:= Length(EdtPrice.Text);
end;
برای نمایش وضعیت شهر های دیگر WOEID شهر خود را از yahoo weather پیدا کرده و در آدرس URL قسمت w= قرار دهید
داشتم با Qr-code اندروید ور میرفتم . یه سرچی کردم دیدم چه یونیت باحالی برای ساخت گزاشتند .
و به صورت سر بسته باید بگم ، qr-code ارتباط پر دردسر بیرون به سیستم رو ، بی دردسر کرده. شما متنی رو با این روش کد میکنید . در قالب یه عکس میدید به دوستتون. کافیه با Qr-Code خوان . دوباره به تکست برش گردونید.
برای دریافت اطلاعات بهتر مراجعه بشه به http://qr-code.ir/document/
این هم سهم من از این کار.
یک کامپوننت بسیار ساده که کار باهاش خیلی راحته.
در ضمن می تونید یک ماسک هم براش تعریف کنید که به جای نقاط سیاه، از ماسک استفاده کنه. فقط حواستون باشه که تو ماسک نقاط سفید زیادی نداشته باشید.
نمونه کار رو هم می تونید تست کنید.
دوستانی که در استفاده از این کامپوننت مشکل Parent دارند این خط رو در متد Create اضافه کنند:
Parent := TWinControl(AOwner);
با سلام
کد زیر نحوه ساخت یک برنامه ریموت دسکتاپ ساده را نشان میدهد. این کد شامل دو پروژه Server و Client است.
این فقط یک مثال ساده است و باید کارهای دیگری برای بالا بردن Performance و ... روی آن صورت پذیرد.
سلامنقل قول:
نوشته شده توسط mbshareat
ضمن تشکر از برنامه بی نظیرتون من برنامه رو با app چک کردم جواب میده (تمام دکمه های ماشین حساب ویندوز رو به متن دلخواه تغییر دادم)ولی چه طوری میشه به یه Edit تو Firefox یا IE متن فرستاد؟ میخوام یه روبات برای پر کردن یه فرم رو اینترنت بنویسم
سلامنقل قول:
نوشته شده توسط AliReza Vafakhah
به ReplaceStr گیر میده! مشکلش چیه؟
نقل قول:
نوشته شده توسط rainstorm
procedure TFrmIns.EdtPriceChange(Sender: TObject);
begin
if (Trim(EdtPrice.Text) = '') then Exit;
EdtPrice.Text:= FormatFloat(',###.##', StrToFloat(StringReplace(EdtPrice.Text,',','',[rfReplaceAll])));
EdtPrice.SelStart:= Length(EdtPrice.Text);
end;
فکر کنم باید اول مقدار EdtPrice.Text را بریزی توی یه رشته که در var تعریف کردی و بعد از تغییرات مجددا جابجایش بکنی.نقل قول:
نوشته شده توسط دلفــي
[QUOTE=دلفــي;2201577][CODE]
procedure TFrmIns.EdtPriceChange(Sender: TObject);
begin
if (Trim(EdtPrice.Text) = '') then Exit;
EdtPrice.Text:= FormatFloat(',###.##', StrToFloat(StringReplace(EdtPrice.Text,',','',[rfReplaceAll])));
EdtPrice.SelStart:= Length(EdtPrice.Text);
end;
[/Cسلام
با تشكر فراوان مشكل با اين اصلاحيه حل شد.ممنون:لبخندساده:
سلام علیکم
فرض کنید یه بیت مپ از یه صفحه کتاب داریم.میخوایم حاشیه های چهار طرف متن رو حذف کنیم.با این پروسیجر میتونید این کار رو بکنید.
من خودم به علت بزرگ بودن تصویر و کوچک بودن رزولوشن صفحه نمایش استفاده می کردم.خودم نوشتم.
در صورتیکه پروسیجر تا محدوده مشخصی به نقطه رنگی متن نرسه از حاشیه تعیین شده توسط کابر استفاده می کنه مثل صفحه هایی که فقط توش نوشته فصل چندم.
سلام مجدد
بهترین کدی که برای تغییر اندازه تصویر با حفظ کیفیت پیدا کردم:
سلام
من ترجمه کردن لاتینم خوب نیست.یه برنامه ساده نوشتم که کلمات بالای سه حرفی از متنی که بهش میدیم رو به ترتیب پر تکرار به کم تکرار، لیست می کنه.و بعد از کپي شدن ترجمه لغات در حافظه(به طور خودکار) ، باید لغات رو در مترجم گوگل ترجمه کرد و بعد در برنامه، با فشار یک دکمه ترجمه هر لغت به لیست کلمات لاتین اضافه میش.برنامه قابلیت جستجوی کلمه لاتین و ذخيره در فايل هم داره.
روند کار اینه:
1.کپی و الصاق متن لاتین در کادر سمت چپ(من مثلا زیرنویس فیلم استاد از وبلاگ رزمیکده رو ریختم-وبلاگ خوبی برای دانلود فیلمهای دوبله رزمی قدیمی)
2.فشار دکمه Get Words.با این کار لیست کلمات، توسط برنامه در حافظه کپی میشه!
3. الصاق لیست کلمات در مترجم گوگل(بعد از تنظیم ترجمه انگلیسی به فارسی)
4.گرفتن لیست ترجمه از مترجم گوگل با کلیک راست و selectAll و کپی(با این کار دو سطر ،قبل و سه سطر، بعد از ترجمه در حافظه ریخته میشه که مربوط به متنهای بالا و پایین صفحه درمترجم گوگل هست که برنامه خودش حذفش می کنه)
5.فشار دکمه "الصاق ترجمه"
اگه میشد ترجمه مناسب برای کلمات گیر اورد و کلمات رو با ترجمه مناسب واژه جایگزین کرد، خوب بود.چون همونطور که می دونید ترجمه متن گوگل قابل استفاده نیست(من که برنامه مناسبی برای ترجمه متن سراغ ندارم!) و مترجم کلمه هم که ده تا کلمه ردیف می کنند.
این هم از برنامه:
ضمیمه 143557
راستی اگر مترجم متن خوبی سراغ دارید، بهم معرفی کنید. ممنون میشم!
نمی دونم میشه یا نه ولی اگه کسی روش کار کنه شاید بشه کلمات بی ارزش (مثلا this) رو از لیست حذف کرد و ترجمه ها رو با هم ترکیب کرد و لیست رو به روز کرد!(کاش این جمعه بیاید..!!)
اگه مسئولین لازم دونستند هم ارسالهای بعدی دوستان رو در صورت قابل فهم بودن توضیحات حذف کنند که تاپیک شلوغ نشه!
تو فکر اینم که برم لیست کلمات رو از فایل بخونم و سختهاش رو ستاره بزنم و در برنامه، دکمه ساخت فایل کلمات سخت (بعد از ستاره دار کردن کلمات سخت)و کلمات جدید (بعد از ترجمه دومین متن)بذارم .لیست کلمات جدید، با حذف لیست کلمات فایل اولیه(اعم از ستاره دار و بی ستاره) و کلمات سخت (که با هر ترجمه به روز میشه) از لیست کلمات ترجمه جدید،به دست میاد!
من اصلا نفهمیدم چی به چیه؟
یه توضیح خوب بده ببینم چطور با این برنامه کار می کنی؟
داش یوسف.
این دوستمون میخاسته بگه که : یه متن میدی به برنامه، میاد بر اساس تکرار هر کلمه میچینتش.
یعنی بیشترین کلمه ای که در متن هست رو اول میچینه و تا پایین.
بعد کلمه هارو میفرسته به گوگل ترنسلیت و معنیشو میزاره جلوش.
بنظر من ابزار الزاما شخصی هست و کاربرد خیلی عمومی نداره.
آخه من هیچ جاش ارسال به گوگل ندیدم.
به نظرم برنامه خوبی می شه از توش در آورد. ولی اونچه که از توضیحاتش فهمیدم و اونچه که دیدم خیلی فرق داشت.
سلام
یه نمونه برنامه که یه لیست از برنامه های دلخواه ایجاد و ذخیره می کنه با سورس برنامه.
(البته می تونید هر نوع فايل رو اضافه و اجرا کنید.من برای اجرای Exe درستش کرد!)
موارد آموزشی:
درگ کردن فایل بر روی پنجره
گرفتن آیکن برنامه
لیست باکس سفارشی(در این برنامه از بیت مپ برای هر سطر استفاده شده)
پنجره ساده فارسی برای پیغام،سوال،دریافت متن
ضمیمه 150251
ضمیمه 150252
این هم یه کم خوشگل ترش!
ضمیمه 150253
یه کد ساده برای استخراج فایلهای اجرایی همنام شاخه.
چند تا برنامه داشتم که روشون کار می کردم و فایلهای اجرایی نهایی رو به اشتراک میذاشتم.گفتم هر فایل رو دستی کپی نکنم
type
TForm1 = class(TForm)
DirectoryListBox1: TDirectoryListBox;
ProgressBar1: TProgressBar;
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
var
I:Word;
A,D,S:String;
begin
A:=ExtractFileDir(Application.exeName);
DirectoryListBox1.Directory:=A;
ProgressBar1.Max:=DirectoryListBox1.Count-DirectoryListBox1.ItemIndex;
For I:=DirectoryListBox1.ItemIndex to DirectoryListBox1.Count-1 do
Begin
ProgressBar1.Position:=I;
Refresh;
D:=DirectoryListBox1.Items[I];
DirectoryListBox1.ItemIndex:=I;
if FileExists(A+'\'+D+'\'+D+'.exe')=true then
CopyFile(PChar(A+'\'+D+'\'+D+'.exe'),PChar(A+'\'+D +'.exe'),false);
End;
Application.Terminate;
end;