به پایین این صفحه مراجه نمایید .

----------------------------------------._._. RAM ._._.----------------------------------------

دوستان از طول کشیدن رفع مشکلات تالار عذر خواهی میکنیم .

هم اکنون میتونید سوالات و پاسخ های خودتان را در پایین این صفحه بنویسید و مشاهده نمایید .

----------------------------------------._._. RAM ._._.---------------------------------------- 

با رفع مشکلات بزودی تالار به  کار خود ادامه خواهد داد .

----------------------------------------._._. RAM ._._.----------------------------------------
نویسنده : رام

بزودی مشکلات مربوط به تالار وبلاگ حل خواهد شد و آموزش ها را ادامه خواهیم داد .

دوستانی که برای یادگیری دلفی علاقمند هستند می توانند با ثبت نام در انجمن از مطالب بهره ببرند .

در ضمن اگر مایل هستید در قسمت نظرات راجع به این پست ابراز کنید که به چه نوع آموزش هایی علاقمند هستید و در ضمن علاقه خود را به چگونگی آموزش ها ( نکات ریز و کلیدی یا مقالات کامل و مفصل ) بنویسید .

بدون شک نظزات شما در شیوه عملکرد ما تاثیر خواهد داشت .

----------------------------------------._._. RAM ._._.----------------------------------------

تبدیل آدرس کوتاه به آدرس بلند

آدرس کوتاه معمولا در داس مورد استفاده قرار می گیرد.

function GetLongPathName(lpszShortPath: PChar; lpszLongPath: PChar;
  cchBuffer: DWORD): DWORD; stdcall;//delphi-center.blogfa.com

  //implementation//delphi-center.blogfa.com
  function GetLongPathName; external kernel32 Name 'GetLongPathNameA';

// -----------------------------------------------------------------------------

function WinAPI_GetLongPathName(const ShortName: string): string;
begin//delphi-center.blogfa.com
  SetLength(Result, MAX_PATH);
  SetLength(Result, GetLongPathName(PChar(ShortName), PChar(Result), MAX_PATH));
end;

نمایش یک Progressbar در Statusbar

قطعا با این نوع نمایش در نرم افزارها آشنا شده اید.(خط پر شونده در نوار وضعیت)

type
  
THackControl = class(TControl);

procedure TfrmWebsite.FormCreate(Sender: TObject);
var
  
PanelRect: TRect;
begin
  
// Place progressbar on the statusbar
  
THackControl(ProgressBar1).SetParent(StatusBar1);
  
// Retreive the rectancle of the statuspanel (in my case the second)
  
SendMessage(StatusBar1.Handle, SB_GETRECT, 1, Integer(@PanelRect));
  
// Position the progressbar over the panel on the statusbar
  
with PanelRect 
do
    
ProgressBar1.SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

ایجاد یک پسورد به صورت خدکار(Random String)

function RandomPassword(PLen: Integer): string;
var
  str: string;
begin
  Randomize;//delphi-center.blogfa.com
  //string with all possible chars
  str    := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  Result := '';
  repeat//delphi-center.blogfa.com
    Result := Result + str[Random(Length(str)) + 1];
  until (Length(Result) = PLen)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin//delphi-center.blogfa.com
  //generate a password with 10 chars
  label1.Caption := RandomPassword(10);
end;

 

function RandomWord(dictSize, lngStepSize, wordLen, minWordLen: Integer): string;
begin//delphi-center.blogfa.com
  Result := '';
  if (wordLen < minWordLen) and (minWordLen > 0) then
    wordLen := minWordLen
  else if (wordLen < 1) and (minWordLen < 1) then wordLen := 1;
  repeat
    Result := Result + Chr(Random(dictSize) + lngStepSize);
  until (Length(Result) = wordLen);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin//delphi-center.blogfa.com
  //generate a password with 10 chars
  Caption := RandomWord(33, 54, Random(12), 2);
end;

جستجوی متن در Memo

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  x: Integer;
  find: Boolean = False;

implementation

{$R *.dfm}

//Suchenbutton:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  a: string;
begin
  Memo1.Lines.Add('');
  Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
  for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
  begin
    a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
    if CheckBox1.Checked = True then
    begin
      if a = edit1.Text then
      begin
        find := True;
        x    := 2;
        Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        Memo1.SetFocus;
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        break;
      end;
    end
    else
    begin
      if lowercase(a) = lowercase(edit1.Text) then
      begin
        Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        find := True;
        x    := 2;
        Memo1.SetFocus;//delphi-center.blogfa.com
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        break;
      end;
    end;
  end;
  if find = False then ShowMessage('SuchString nicht gefunden')
  else
    find := False;
end;

//Weitersuchenbutton:

procedure TForm1.Button2Click(Sender: TObject);
var//delphi-center.blogfa.com
  i: Integer;
  a: string;
  d: Integer;
begin
  d := 0;
  for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
  begin
    a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
    if CheckBox1.Checked = True then
    begin
      if a = edit1.Text then
      begin
        d := d + 1;
        if d = x then
        begin
          find := True;
          x    := x + 1;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
          Memo1.SetFocus;
          Memo1.SelStart  := i - 1;
          Memo1.SelLength := Length(edit1.Text);
          break;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        end;
      end;
    end
    else
    begin
      if lowercase(a) = lowercase(edit1.Text) then
      begin
        d := d + 1;
        if d = x then
        begin
          find := True;
          x    := x + 1;//delphi-center.blogfa.com
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
          Memo1.SetFocus;
          Memo1.SelStart  := i - 1;
          Memo1.SelLength := Length(edit1.Text);
          break;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        end;
      end;
    end;
  end;
  if find = False then ShowMessage('SuchString nicht gefunden')
  else
    find := False;
end;

خاموش کردن ویندوز/لوگ آف/ری استارت XP/98

function MyExitWindows(RebootParam: Longword): Boolean;
var
  TTokenHd: THandle;
  TTokenPvg: TTokenPrivileges;
  cbtpPrevious: DWORD;
  rTTokenPvg: TTokenPrivileges;
  pcbtpPreviousRequired: DWORD;
  tpResult: Boolean;
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    tpResult := OpenProcessToken(GetCurrentProcess(),
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      TTokenHd);
    if tpResult then
    begin
      tpResult := LookupPrivilegeValue(nil,
                                       SE_SHUTDOWN_NAME,
                                       TTokenPvg.Privileges[0].Luid);
      TTokenPvg.PrivilegeCount := 1;
      TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      cbtpPrevious := SizeOf(rTTokenPvg);
      pcbtpPreviousRequired := 0;
      if tpResult then
        Windows.AdjustTokenPrivileges(TTokenHd,
                                      False,
                                      TTokenPvg,
                                      cbtpPrevious,
                                      rTTokenPvg,
                                      pcbtpPreviousRequired);
    end;
  end;
  Result := ExitWindowsEx(RebootParam, 0);
end;

// Example to shutdown Windows:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyExitWindows(EWX_POWEROFF or EWX_FORCE);
end;

// Example to reboot Windows:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyExitWindows(EWX_REBOOT or EWX_FORCE);
end;


// Parameters for MyExitWindows()

 

 

{2. Console Shutdown Demo}

program Shutdown;
{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

// Shutdown Program
// (c) 2000 NeuralAbyss Software
//
www.neuralabyss.com

var
  logoff: Boolean = False;
  reboot: Boolean = False;
  warn: Boolean = False;
  downQuick: Boolean = False;
  cancelShutdown: Boolean = False;
  powerOff: Boolean = False;
  timeDelay: Integer = 0;

function HasParam(Opt: Char): Boolean;
var
  x: Integer;
begin
  Result := False;
  for x := 1 to ParamCount do
    if (ParamStr(x) = '-' + opt) or (ParamStr(x) = '/' + opt) then Result := True;
end;

function GetErrorstring: string;
var
  lz: Cardinal;
  err: array[0..512] of Char;
begin
  lz := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil);
  Result := string(err);
end;

procedure DoShutdown;
var
  rl, flgs: Cardinal;
  hToken: Cardinal;
  tkp: TOKEN_PRIVILEGES;
begin
  flgs := 0;
  if downQuick then flgs := flgs or EWX_FORCE;
  if not reboot then flgs := flgs or EWX_SHUTDOWN;
  if reboot then flgs := flgs or EWX_REBOOT;
  if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF;
  if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or
      EWX_LOGOFF;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      hToken) then
      Writeln('Cannot open process token. [' + GetErrorstring + ']')
    else
    begin
      if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
      begin
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        tkp.PrivilegeCount           := 1;
        AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
        if GetLastError <> ERROR_SUCCESS then
          Writeln('Error adjusting process privileges.');
      end
      else
        Writeln('Cannot find privilege value. [' + GetErrorstring + ']');
    end;
    {   if CancelShutdown then
          if AbortSystemShutdown(nil) = False then
            Writeln(\'Cannot abort. [\' + GetErrorstring + \']\')
          else
           Writeln(\'Cancelled.\')
       else
       begin
         if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then
            Writeln(\'Cannot go down. [\' + GetErrorstring + \']\')
         else
            Writeln(\'Shutting down!\');
       end;
    }
  end;
  //     else begin
  ExitWindowsEx(flgs, 0);
  //     end;
end;

begin
  Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)');
  Writeln('(c) 2000 NeuralAbyss Software. All Rights Reserved.');
  if HasParam('?') or (ParamCount = 0) then
  begin
    Writeln('Usage:    shutdown [-akrhfnc] [-t secs]');
    Writeln('                  -k:      don''t really shutdown, only warn.');
    Writeln('                  -r:      reboot after shutdown.');
    Writeln('                  -h:      halt after shutdown.');
    Writeln('                  -p:      power off after shutdown');
    Writeln('                  -l:      log off only');
    Writeln('                  -n:      kill apps that don''t want to die.');
    Writeln('                  -c:      cancel a running shutdown.');
  end
  else
  begin
    if HasParam('k') then warn := True;
    if HasParam('r') then reboot := True;
    if HasParam('h') and reboot then
    begin
      Writeln('Error: Cannot specify -r and -h parameters together!');
      Exit;
    end;
    if HasParam('h') then reboot := False;
    if HasParam('n') then downQuick := True;
    if HasParam('c') then cancelShutdown := True;
    if HasParam('p') then powerOff := True;
    if HasParam('l') then logoff := True;
    DoShutdown;
  end;
end.

 


 
// Parameters for MyExitWindows()


EWX_LOGOFF

Shuts down all processes running in the security context of the process that called the
ExitWindowsEx function. Then it logs the user off.

Alle Prozesse des Benutzers werden beendet, danach wird der Benutzer abgemeldet.

EWX_POWEROFF

Shuts down the system and turns off the power.
The system must support the power-off feature.
Windows NT/2000/XP:
The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter und setzt den Computer in den StandBy-Modus,
sofern von der Hardware unterstützt.

EWX_REBOOT

Shuts down the system and then restarts the system.
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter und startet es neu.

EWX_SHUTDOWN

Shuts down the system to a point at which it is safe to turn off the power.
All file buffers have been flushed to disk, and all running processes have stopped.
If the system supports the power-off feature, the power is also turned off.
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter.

 
EWX_FORCE

Forces processes to terminate. When this flag is set,
the system does not send the WM_QUERYENDSESSION and WM_ENDSESSION messages.
This can cause the applications to lose data.
Therefore, you should only use this flag in an emergency.

Die aktiven Prozesse werden zwangsweise und ohne Rückfrage beendet.

EWX_FORCEIFHUNG

Windows 2000/XP: Forces processes to terminate if they do not respond to the
WM_QUERYENDSESSION or WM_ENDSESSION message. This flag is ignored if EWX_FORCE is used.

Windows 2000/XP: Die aktiven Prozesse werden aufgefordert, sich selbst zu beenden und
müssen dies bestätigen. Reagieren sie nicht, werden sie zwangsweise beendet.

شبیه سازی کلیک

این کدها نمایش گر موس را به نقطه ی تنظیم شده می برند و یک کلیک انجام می دهند:

SetCursorPos(10, 20);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
GetDoubleClickTime;
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
SendMessage(Panel1.Handle, WM_LBUTTONDBLCLK, 10, 10)

اعمال تنظیمات بر روی Taskbar

var
  
wndTaskbar: HWND;
begin
  
wndTaskbar := FindWindow('Shell_TrayWnd', nil);
  if wndTaskbar <> 0 
then
  begin
    
EnableWindow(wndTaskbar, False); 
// Disable the taskbar
    
EnableWindow(wndTaskbar, True);  
// Enable the taskbar
    
ShowWindow(wndTaskbar, SW_HIDE); 
// Taskbar vertecken
    
ShowWindow(wndTaskbar, SW_SHOW); 
// Taskbar anzeigen
  
end;
end;

فرمت کردن درایو

در هنگام آزمایش مراقب باشید.

const 
  
SHFMT_DRV_A = 0;
  SHFMT_DRV_B = 1;
  SHFMT_ID_DEFAULT = $FFFF;
  SHFMT_OPT_QUICKFORMAT = 0;
  SHFMT_OPT_FULLFORMAT = 1;
  SHFMT_OPT_SYSONLY = 2;
  SHFMT_ERROR = -1;
  SHFMT_CANCEL = -2;
  SHFMT_NOFORMAT = -3;

function SHFormatDrive(hWnd: HWND;
  Drive: Word;
  fmtID: Word;
  Options: Word): Longint
  stdcallexternal 'Shell32.dll' Name 'SHFormatDrive';


procedure TForm1.Button1Click(Sender: TObject);
var
  
FmtRes: Longint;
begin
  try
    
FmtRes := ShFormatDrive(Handle,
      SHFMT_DRV_A,
      SHFMT_ID_DEFAULT,
      SHFMT_OPT_QUICKFORMAT);
    case FmtRes 
of
      
SHFMT_ERROR: ShowMessage('Error formatting the drive');
      SHFMT_CANCEL: ShowMessage('User canceled formatting the drive');
      SHFMT_NOFORMAT: ShowMessage('No Format')
        
else
          
ShowMessage('Disk has been formatted!');
    end;
  
except
    
ShowMessage('Error Occured!');
  end;
end;


var
  
EMode: Word;
begin
  
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  
// ShFormatDrive Code....
  
SetErrorMode(EMode);
end;

بدست آوردن زمان Uptime ویندوز(مدت زمانی که ویندوز در حال استفاده است)

قطعا تا کنون با این مورد در برنامه های زیادی روبرو شدید.توسط این کد می توانید تشخیص دهید که ویندوز چه مدت است که در حال اجراست:

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 := 'Uptime: ' + IntToStr(d) + ' Days ' + IntToStr(h) + ' Hours ' + IntToStr(m) +
    ' Minutes ' + IntToStr(s) + ' Seconds';
end;

//Sample


procedure TForm1.Button1Click(Sender: TObject);
begin
  label1.Caption := UpTime;
end;

Code by: Simon Grossenbacher

Minimize کردن تمام پنجره ها

procedure TForm1.Button1Click(Sender: TObject);
var
  h: HWnd;
begin
  h := Handle;
  while h > 0 do
  begin
    if IsWindowVisible(h) then
      PostMessage(h, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    h := GetNextWindow(h, GW_HWNDNEXT);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Keybd_event(VK_LWIN, 0, 0, 0);
  Keybd_event(Byte('M'), 0, 0, 0);
  Keybd_event(Byte('M'), 0, KEYEVENTF_KEYUP, 0);
  Keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;

دانلود یک تصویر jpg و خروجی به صورت bmp

با این کد می توانید یک تصویر jpg را دانلود کنید و در نهایت آن را به صورت bmp نمایش دهید(تبدیل نوع فایل پس از دانلود).مثال برا استفاده نیز درج شده است:

uses Jpeg, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

{ .... }

function DownloadJPGToBitmap(const URL : string; ABitmap: TBitmap): Boolean;
var
  idHttp: TIdHTTP;
  ImgStream: TMemoryStream;
  JpgImage: TJPEGImage;
begin
  Result := False;
  ImgStream := TMemoryStream.Create;
  try //delphi-center.blogfa.com
    idHttp := TIdHTTP.Create(nil);
    try
      idHttp.Get(URL, ImgStream);
    finally
      idHttp.Free;
    end;//delphi-center.blogfa.com
    ImgStream.Position := 0;
    JpgImage := TJPEGImage.Create;
    try//delphi-center.blogfa.com
      JpgImage.LoadFromStream(ImgStream);
      ABitmap.Assign(JpgImage);
    finally
      Result := True;
      JpgImage.Free;
    end;
  finally//delphi-center.blogfa.com
    ImgStream.Free;
  end;
end;


// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin//delphi-center.blogfa.com
  DownloadJPGToBitmap('http://www.sample.com/test.jpg', Image1.Picture.Bitmap);
end;

بدست اوردن Memory Usage یک Process

ار کد زیر استفاده کنید.مثال هم درج شده است:

uses
  psAPI;


//...

function GetProcessMemorySize(_sProcessName: string; var _nMemSize: Cardinal): Boolean;
var//Delphi-center.blogfa.com
  l_nWndHandle, l_nProcID, l_nTmpHandle: HWND;
  l_pPMC: PPROCESS_MEMORY_COUNTERS;
  l_pPMCSize: Cardinal;
begin
  l_nWndHandle := FindWindow(nil, PChar(_sProcessName));

  if l_nWndHandle = 0 then
  begin

    Result := False;
    Exit;
  end;
//Delphi-center.blogfa.com

  l_pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS);

  GetMem(l_pPMC, l_pPMCSize);
  l_pPMC^.cb := l_pPMCSize;

  GetWindowThreadProcessId(l_nWndHandle, @l_nProcID);
  l_nTmpHandle := OpenProcess(PROCESS_ALL_ACCESS, False, l_nProcID);

  if (GetProcessMemoryInfo(l_nTmpHandle, l_pPMC, l_pPMCSize)) then
    _nMemSize := l_pPMC^.WorkingSetSize
  else
    _nMemSize := 0;

  FreeMem(l_pPMC);

  Result := True;
end;

//Beispiel

مثال:

procedure TForm1.Button1Click(Sender: TObject);
var
  l_nSize: Cardinal;
begin
  if (GetProcessMemorySize('Unbenannt - Editor', l_nSize)) then
    ShowMessage('Size: ' + IntToStr(l_nSize) + ' byte')
//Delphi-center.blogfa.com
  else
    ShowMessage('Error');
end;

تغییر شکل ویندوز بین حالت Default و Classic

با این کد می توانید به راحتی بین شکل فعلی ویندوز XP و شکل Classic تغییر دهید.

type
  SHELLSTATE = record
    Flags1: DWORD;
(*
    BOOL fShowAllObjects : 1;
    BOOL fShowExtensions : 1;
    BOOL fNoConfirmRecycle : 1;

    BOOL fShowSysFiles : 1;
    BOOL fShowCompColor : 1;
    BOOL fDoubleClickInWebView : 1;
    BOOL fDesktopHTML : 1;
    BOOL fWin95Classic : 1;
    BOOL fDontPrettyPath : 1;
    BOOL fShowAttribCol : 1; // No longer used, dead bit
    BOOL fMapNetDrvBtn : 1;
    BOOL fShowInfoTip : 1;
    BOOL fHideIcons : 1;
    BOOL fWebView : 1;
    BOOL fFilter : 1;
    BOOL fShowSuperHidden : 1;
    BOOL fNoNetCrawling : 1;
*)
    dwWin95Unused: DWORD; // Win95 only - no longer supported pszHiddenFileExts
    uWin95Unused: UINT; // Win95 only - no longer supported cbHiddenFileExts

    // Note: Not a typo!  This is a persisted structure so we cannot use LPARAM
    lParamSort: Integer;
    iSortDirection: Integer;

    version: UINT;

    // new for win2k. need notUsed var to calc the right size of ie4 struct
    // FIELD_OFFSET does not work on bit fields
    uNotUsed: UINT; // feel free to rename and use
    Flags2: DWORD;
(*
    BOOL fSepProcess: 1;
    // new for Whistler.
    BOOL fStartPanelOn: 1;       //Indicates if the Whistler StartPanel mode is ON or OFF.
    BOOL fShowStartPage: 1;      //Indicates if the Whistler StartPage on desktop is ON or OFF.
    UINT fSpareFlags : 13;
*)
  end;
  LPSHELLSTATE = ^SHELLSTATE;

const
  SSF_SHOWALLOBJECTS  = $00000001;
  SSF_SHOWEXTENSIONS  = $00000002;
  SSF_HIDDENFILEEXTS  = $00000004;
  SSF_SERVERADMINUI   = $00000004;
  SSF_SHOWCOMPCOLOR   = $00000008;
  SSF_SORTCOLUMNS     = $00000010;
  SSF_SHOWSYSFILES    = $00000020;
  SSF_DOUBLECLICKINWEBVIEW = $00000080;
  SSF_SHOWATTRIBCOL   = $00000100;
  SSF_DESKTOPHTML     = $00000200;
  SSF_WIN95CLASSIC    = $00000400;
  SSF_DONTPRETTYPATH  = $00000800;
  SSF_SHOWINFOTIP     = $00002000;
  SSF_MAPNETDRVBUTTON = $00001000;
  SSF_NOCONFIRMRECYCLE = $00008000;
  SSF_HIDEICONS       = $00004000;
  SSF_FILTER          = $00010000;
  SSF_WEBVIEW         = $00020000;
  SSF_SHOWSUPERHIDDEN = $00040000;
  SSF_SEPPROCESS      = $00080000;
  SSF_NONETCRAWLING   = $00100000;
  SSF_STARTPANELON    = $00200000;
  SSF_SHOWSTARTPAGE   = $00400000;


procedure SHGetSetSettings(var lpss: SHELLSTATE; dwMask: DWORD; bSet: BOOL) stdcall;
  external
'shell32.dll';

procedure SwitchStartpanelXP(xpstyle: Boolean);
var
  lpss: SHELLSTATE;
  bIsXPstyle: Boolean;
begin
  ZeroMemory(@lpss, SizeOf(lpss));
  // Retrieve current style
  SHGetSetSettings(lpss, SSF_STARTPANELON, False);
  // Check the current style
  bIsXPstyle := (lpss.Flags2 and 2) = 2; // fStartPanelOn
  // If a change occurred
  if (bIsXPstyle <> xpstyle) then
  begin
    // If the user wants XP style then set it, else reset it
    if (xpstyle) then
      lpss.Flags2 := 2 // fStartPanelOn = 1
    else
      lpss.Flags2 := 0; // fStartPanelOn = 0
    // Set new style
    SHGetSetSettings(lpss, SSF_STARTPANELON, True);
    // Notify desktop of the change
    PostMessage(FindWindow('Progman', nil), WM_USER + $60, 0, 0);
  end;
  // Notify taskbar
  PostMessage(FindWindow('Shell_TrayWnd', nil), WM_USER + $0D, 0, 0);
end;

از کار انداختن فایروال ویندوز XP

program matador;

{$APPTYPE GUI}

uses
  
Windows, winsvc, shellapi;
  
procedure Close_Firewal;
var
  
SCM, hService: LongWord;
  sStatus: TServiceStatus;
begin
  
SCM      := OpenSCManager(nilnil, SC_MANAGER_ALL_ACCESS);
  hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS);

  ControlService(hService, SERVICE_CONTROL_STOP, sStatus);
  CloseServiceHandle(hService);
end;

begin
  
Close_Firewal;
end.