ايران ويج

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

حذف یک پوشه با زیر مجموعه هایش

کد: 
uses

Winapi.ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);

var

shf:TSHFileOpStruct;

begin

shf.Wnd:=Handle;

shf.wFunc:=FO_DELETE;

shf.pFrom:=PChar('D:\pic');

shf.pTo:=nil;

shf.fFlags:=FOF_NO_UI;

SHFileOperation(shf);

end;

پیدا کردن ورژن فایل.

کد: 
Function GetVersionFile(PathFile:string): string;

var

  VerInfoSize: DWORD;

  VerInfo: Pointer;

  VerValueSize: DWORD;

  VerValue: PVSFixedFileInfo;

  Dummy: DWORD;

begin

 Result := '';

 VerInfoSize := GetFileVersionInfoSize(PChar(Trim(PathFile)), Dummy);

 if VerInfoSize = 0 then Exit;

   GetMem(VerInfo, VerInfoSize);

 GetFileVersionInfo(PChar(Trim(PathFile)), 0, VerInfoSize, VerInfo);

 VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);

 With VerValue^ do

   begin

     Result := IntToStr(dwFileVersionMS shr 16);

     Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF);

     Result := Result + '.' + IntToStr(dwFileVersionLS shr 16);

     Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF);

 End;

 FreeMem(VerInfo, VerInfoSize);

end;

نمایش نوع اتصال به اینترنت

کد: 
uses

WinInet;

function GetConnectionKind(var strKind: string): Boolean;

var

  flags: DWORD;

begin

  strKind := '';

  Result := InternetGetConnectedState(@flags, 0);

  if Result then

  begin

    if (flags and MODEM) = MODEM then strKind := 'Modem';

    if (flags and LAN) = LAN then strKind := 'LAN';

    if (flags and prxoy) = prxoy then strKind := 'prxoy';

    if (flags and BUSY) = BUSY then strKind := 'Modem Busy';

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

  strKind: string;

begin

  if GetConnectionKind(strKind) then

    ShowMessage(strKind);

end;

بدست اوردن لیست درایوها در لدفی 2010 به بالا

کد: 
uses

System.IOUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

drive:string;

begin

for drive in TDirectory.GetLogicalDrives do

ListBox1.Items.Add(drive);

end;

لیست تمتم پوشه ها و زیر پوشه های یک ادرس در دلفی 2010 به بالا

کد: 
uses

System.IOUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

dir:string;

begin

for dir in TDirectory.GetDirectories('d:\','*',TSearchOption.soAllDirectories) do

ListBox1.Items.Add(dir);

end;

base64 با استفاده از توابع api فقط در ویندوز7

کد: 
unit XPBase64;

// Author: snowy, dumb.

interface

uses Windows;

const

  crypt32 = 'Crypt32.dll';

  // Flags:

  CRYPT_STRING_BASE64HEADER = 0;

  // Base64, with certificate Beginning and ending headers

  CRYPT_STRING_BASE64 = 1;

  // Base64, without headers

  CRYPT_STRING_BINARY = 2;

  // pure binary copy

  CRYPT_STRING_BASE64REQUESTHEADER = 3;

  // Base64, with request Beginning and ending headers

  CRYPT_STRING_HEX = 4;

  // Hexadecimal Only

  CRYPT_STRING_HEXASCII = 5;

  // Hexadecimal, with ASCII character display

  CRYPT_STRING_BASE64X509CRLHEADER = 9;

  // Base64, with X.509 CRL Beginning and ending headers

  CRYPT_STRING_HEXADDR = 10;

  // Hexadecimal, with Address display

  CRYPT_STRING_HEXASCIIADDR = 11;

  // Hexadecimal, with ASCII character display and Address

  CRYPT_STRING_HEXRAW = 12;

  // A raw hex string.

function ToBase64(s: string; Flags: dword = CRYPT_STRING_BASE64REQUESTHEADER): string;

function FromBase64(s: string; Flags: dword = CRYPT_STRING_BASE64REQUESTHEADER): string;

function CryptStringToBinary(pszString: PChar; cchString: dword; dwFlags: dword; pbBinary: pointer; var pcbBinary: dword; var pdwSkip: dword;

         var pdwFlags: dword): Boolean; stdcall;

function CryptBinaryToString(pbBinary: pointer; cbBinary: dword; dwFlags: dword; pszString: PChar; var pcchString: dword): Boolean; stdcall;

function CryptStringToBinaryA(pszString: PChar; cchString: dword; dwFlags: dword; pbBinary: pointer; var pcbBinary: dword; var pdwSkip: dword;

         var pdwFlags: dword): Boolean; stdcall;

function CryptBinaryToStringA(pbBinary: pointer; cbBinary: dword; dwFlags: dword; pszString: PChar; var pcchString : dword): Boolean; stdcall;

function CryptStringToBinaryW(pszString: PWideChar; cchString: dword; dwFlags: dword; pbBinary: pointer; var pcbBinary: dword; var pdwSkip: dword;

         var pdwFlags: dword): Boolean; stdcall;

function CryptBinaryToStringW(pbBinary: pointer; cbBinary: dword; dwFlags: dword; pszString: PWideChar; var pcchString: dword): Boolean; stdcall;

Implementation

function CryptStringToBinary; external crypt32 name 'CryptStringToBinaryA';

function CryptBinaryToString; external crypt32 name 'CryptBinaryToStringA';

function CryptStringToBinaryA; crypt32 external name 'CryptStringToBinaryA';

function CryptBinaryToStringA; external crypt32 name 'CryptBinaryToStringA';

function CryptStringToBinaryW; external crypt32 name 'CryptStringToBinaryW';

function CryptBinaryToStringW; external crypt32 name 'CryptBinaryToStringW';

function ToBase64(s: string; Flags: dword = CRYPT_STRING_BASE64REQUESTHEADER): string;

var sz: dword;

begin

  CryptBinaryToString(pointer(s), Length(s), Flags, nil, sz);

  SetLength(result, sz);

  CryptBinaryToString(pointer(s), Length(s), Flags, pointer(result), sz);

end;

function FromBase64(s: string; Flags: dword = CRYPT_STRING_BASE64REQUESTHEADER): string;

var sz, Skip: dword;

begin

  CryptStringToBinary(pointer(s), Length(s), Flags, nil, sz , Skip, Flags);

  SetLength(result, sz);

  CryptStringToBinary(pointer(s), Length(s), Flags, pointer(result), sz, Skip, Flags);

end;

end.

روش استفاده از یونیت فوق

کد: 
uses XPBase64;

// Author: snowy, dumb.

procedure TForm1.Button1Click(Sender: TObject);

begin

  MEMO2 include.Text : = ToBase64(Memo1.Text);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  Memo3.Text : = FromBase64(MEMO2 include.Text);

end;

گرفتن ورژن و نام سیستم عامل ویندوز تا ویندوز 8

کد: 
function WindowsVersion: String;

begin

 Result := 'Unknown';

 if Win32Platform = VER_PLATFORM_WIN32_NT then

 case Win32MajorVersion of

  4: Result := 'Windows NT';

  5: case Win32MinorVersion of

      0: Result := 'Windows 2000';

      1: Result := 'Windows XP';

      2: Result := 'Windows 2003 Server';

     end;

  6: case Win32MinorVersion of

      0: Result := 'Windows Vista';

      1: Result := 'Windows 7';

      2: Result := 'Windows 8';

     end;

 end else

 case Win32MinorVersion of

  00: Result := 'Windows 95';

  10: if Trim(Win32CSDVersion) = 'A' then Result := 'Windows 98 SE'

      else Result := 'Windows 98';

  90: Result := 'Windows ME';

 end;

 if Win32BuildNumber >0 then

 result:=result+' '+inttostr(Win32BuildNumber)+ ' ' +Win32CSDVersion;

end;

استفاده

کد: 
ShowMessage(WindowsVersion);

تشخیص برنامه های 32/64 بیتی بدون اجرا کردن

کد: 
// Detect 32 / 64 Applications

 // Coded By Arash Veyskarami

 //////////////////////////////

 function Get_32_64(Filename:string):string;

 var

 Mch:Dword;

 dos_header: IMAGE_DOS_HEADER;

 pe_header: IMAGE_FILE_HEADER;

 opt_header: IMAGE_OPTIONAL_HEADER;

 fs:TFilestream;

 signature: DWORD;

 function DumpPEHeader(const h: IMAGE_FILE_HEADER):dword;

 begin

 Result:=h.Machine;

 end;

 begin

 fs := TFilestream.Create(FileName, $0000 or $0040);

 try

 fs.read(dos_header, SizeOf(dos_header));

 if dos_header.e_magic <> IMAGE_DOS_SIGNATURE then

 Exit;

 fs.seek(dos_header._lfanew, soFromBeginning);

 fs.read(signature, SizeOf(signature));

 finally

 fs.read(pe_header, SizeOf(pe_header));

 Mch:=DumpPEHeader(pe_header);

 fs.Free;

 end;

 if Mch = $14C then Result:='32 Bit' ;

 if Mch = $8664 then Result:='64 Bit';

 end;

 ///////////////////////////////////////

تبدیل ادرس اینترنتی به ip

کد: 
uses

  Winsock;

function IAddrToHostName(const IP: string): string;

var

  i: Integer;

  p: PHostEnt;

begin

  Result := '';

  i      := inet_addr(PChar(IP));

  if i <> u_long(INADDR_NONE) then

  begin

    p := GetHostByAddr(@i, SizeOf(Integer), PF_INET);

    if p <> nil then Result := p^.h_name;

  end

  else

    Result := 'Invalid IP address';

end;

گرفتن فرمت درایو fat32 یا ntfs

کد: 
function GetHardDiskPartitionType(const DriveLetter: Char): string;

var

  NotUsed: DWORD;

  VolumeFlags: DWORD;

  VolumeInfo: array[0..MAX_PATH] of Char;

  VolumeSerialNumber: DWORD;

  PartitionType: array[0..32] of Char;

begin

  GetVolumeInformation(PChar(DriveLetter + ':\'),

    nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,

    VolumeFlags, PartitionType, 32);

  Result := PartitionType;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(GetHardDiskPartitionType('c'));

  ShowMessage(GetHardDiskPartitionType('a'));

end;

حذف فایل با استفاده از توابع ntdll

کد: 
function NtDeleteFile(ObjectAttributes:POBJECT_ATTRIBUTES):DWORD; stdcall; external 'ntdll;

function _DeleteFile(fileName:string):DWORD;

var

   oa:OBJECT_ATTRIBUTES;

   ws1, ws2:WideString;

   us:UNICODE_STRING;

begin

   Result := $C0000001; // STATUS_UNSUCCESSFUL, "generic" error 

   ws1 := fileName; // automatic String -> WideString conversion

   SetLength(ws2, MAX_PATH);

   us.Length := MAX_PATH;

   us.MaximumLength := MAX_PATH;

   us.Buffer := @ws2[1];

   if not RtlDosPathNameToNtPathName_U(@ws1[1], us, nil, nil)

      then Exit;

   oa.Length := SizeOf(OBJECT_ATTRIBUTES);

   oa.RootDirectory := 0;

   oa.ObjectName := @us;

   oa.Attributes := $40; // case insensitive

   oa.SecurityDescriptor := nil;

   oa.SecurityQualityOfService := nil;

   Result := NtDeleteFile(@oa); // pass on the NTSTATUS

end;

نمایش format dialog

کد: 
uses

shellapi

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShellExecute(Application.Handle,

               PChar('Open'),

               PChar('C:\Windows\Rundll32.exe'),

               PChar('Shell32.dll,SHFormatDrive'),

               PChar('C:\Windows'),

               SW_SHOWNORMAL);

end;

ارسال PM به یاهو مسنجر 11.5 (فقط جنبه داشته باشید Biggrin

)

کد: 
+ uses tlhelp32,shellapi

کد: 
function PidToPath(dwProcessID: DWord): string;

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 IsYahooConnected(Wnd: HWND): Boolean;

begin;

Result := (GetMenuItemCount(GetMenu(Wnd)) > 3);

end;

function SendPM(YHandle:hwnd;ToUser,PM:Pchar):boolean;

var

 y:hwnd;

 Wnd,Ins,New,F:Hwnd;

 pd,pa:cardinal;

begin

Result:=False;

if YHandle = 0 then exit;

if not IsYahooConnected(YHandle) then Exit;

SetForeGroundWindow(YHandle);

GetWindowThreadProcessId(YHandle,pd);

Ins:=FindWindowEx(YHandle,0,'#32770',nil);

ShellExecute(Ins,'',Pchar(PidToPath(Pd)),Pchar('ymsgr:sendim?'+ToUser+'&m='+PM ),'',0);

SetForeGroundWindow(YHandle);

while true do

begin

New:=FindWindow('CTabbedIMHost',nil);

Wnd:=FindWindowEx(New,0,'CConvWndBase',nil);

Wnd:=FindWindowEx(Wnd,0,'Button','Send');

GetWindowThreadProcessId(Wnd,pa);

SetForeGroundWindow(YHandle);

if Wnd > 0 then

begin

if pd = pa then SetParent(New,Ins) else exit;

PostMessage(Wnd, WM_KEYDOWN, VK_RETURN, 0);

Sleep(100);

break;

end;

end;

Sleep(1000);

SendMessage(New,WM_CLOSE,0,0);

end;

:use

کد: 
var

YHandle:hwnd;

begin

YHandle:=FindWindow('YahooBuddyMain',nil);

SendPm(YHandle,Pchar('YahooId'),Pchar('Salam'));

end;

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

lord_viper

The.Ghost

lord_viper

lord_viper

lord_viper

lord_viper

veyskarami

lord_viper

lord_viper

lord_viper

veyskarami