می خندم به روزهایی که این وبلاگ رو می نوشتم.
هرچند آماتور بودنم تو اون زمان معلومه.افتخار می کنم و می خندم به خودم!
داستان دلفی سنتر تموم شد.
هرچند هنوزم بشدت مشغولم به برنامه نویسی!
قابل دسترسی است.
----------------------------------------._._. RAM ._._.----------------------------------------
با سلام خدمت شما دوستان خوبم .
با توجه به علاقه ای که به ادامه آموزش ها و پاسخ به سوالات از طرف شما دیده شد و با در نظر گرفتن اینکه ما به دلایلی مجبور به برداشتن تالار قبلی وبلاگ شدیم . لینک زیر را که شامل بخش عمده ای از سوالات و پاسخ های این وبلاگ در تالار قبلی خود هست را قرار می دهم . میتونید مطالب بسیار مفیدی را در این لینک بدست آورید .
در ضمن اگر سوالی درباره برنامه نویسی دلفی دارید . در پایین همین وبلاگ بنویسید . در صورت دانستن پاسخ در اصرع وقت پاسخ خواهید گرفت .
( در صورت Load نشدن تالار پایین این وبلاگ صفحه را دوباره Refresh نمایید .)
موفق و پیروز باشید .
----------------------------------------._._. 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;
قطعا با این نوع نمایش در نرم افزارها آشنا شده اید.(خط پر شونده در نوار وضعیت)
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;
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;
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;
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)
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
stdcall; external '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;
قطعا تا کنون با این مورد در برنامه های زیادی روبرو شدید.توسط این کد می توانید تشخیص دهید که ویندوز چه مدت است که در حال اجراست:
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
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;
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;
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;
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;
program matador;
{$APPTYPE GUI}
uses
Windows, winsvc, shellapi;
procedure Close_Firewal;
var
SCM, hService: LongWord;
sStatus: TServiceStatus;
begin
SCM := OpenSCManager(nil, nil, 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.
نویسنده : ..:: رام ::..
سلام بر تمام ایرونی ها در سراسر دنیا و عرض تبریک سال جدید و نوروز 1385 خورشیدی 
از خداوند ایران برای تک تک شما دوستان آرزوی موفقیت و شادکامی میکنم و از پروردگار عاشق خواستار سال پر از شادی برای تمام ایرونی ها و بخصوص جوونای انرژیک هستم .
از تمام عزیزانی که در این وبلاگ پست زدند و نظر دادند ( از جمله خودم 
) و این محیط را تشکیل دادند تشکر میکنم و از همه دوستان می خوام که این وبلاگ را فراموش نکنند و به ما سر بزنند و در تالار اون مسائلشون را مطرح کنند .
تا بزودی در سایت جدید با همدیگه کار کنیم و محیط آموزنده و مفید و شادی را بسازیم .
در اینجا جا داره که یه تشکر ویژه هم از مدیر وبلاک ( آقا کوشای گل ) داشته باشم که ضمن تهیه مطالب و محیط این وبلاگ و یوزر بنده زحمت ساخت سایت جدید را نیز کشیدند و الآن هم در حال پیگیری مسائل مربوط به اون هستند .
..........Ram.......... زنده باد عشق
زنده باد هرچی جوون عاشقه ..........Ram..........
امیدوارم که همه جوونای ایرونی شاد باشند .
رام :
کوشای عزیز لطف کرد و یوزری را اجالتا برای من در وبلاگ خودش ایجاد کرد .
صحبت خاصی نیست . فقط منتظر سایت باشید مطمئنا یک سایت پویا و خوبی با کمک همدیگه میتونیم بسازیم که محلی باشه برای دوستداران برنامه نویسی به خصوص دلفی موضوعات دیگر اوون را نیز به زودی خودتون خواهید دید .
از تمام دوستانی که تا به حال در بخش تالار این وبلاگ پست زدند متشکریم وامیدواریم که به ارتباط خودشون ادامه بدهند و کمی هم منتظر بمونند تا به زودی در سایت جدید باب صحبت ها را با هم باز کنیم.
همچنین امیدوارم که چند دوستی که به دلایلی توی تالار ابراز نا مهربانی کردند هم با ایجاد رابطه بهتر به محیط صمیمی بروبچه های این وبلاگ ( و سایت آینده ) بپیوندند . من در همینجا از طرف خودم و کوشای عزیز از اونها هم دعوت به دوستی می کنم .
به زودی آدرس سایت جدید را براتون در همین وبلاگ مینویسیم . منتظر نظرات و پیشنهاد های شما دوستای خوبمون هستیم .
به یاری پروردگار مهر و دوستی محیطی صمیمی و سایتی اصولی خواهیم ساخت.
نویسنده : ... رام ...
uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute (HWND(nil), 'open', 'taskmgr', '', '', SW_SHOWNORMAL);
end;
function ChangeSize(Handle: Hwnd; dHeight, dWidth: Integer; ScreenCenter: Boolean): Boolean;
var
P: TRect;
begin
Result := False;
try
GetWindowRect(Handle, P); {Der TRect var die Positions daten des Fenster übergeben}
if ScreenCenter then
MoveWindow(Handle, (Screen.Width-dWidth) div 2, (Screen.Height-dHeight) div 2, dHeight, dWidth, True)
else
MoveWindow(Handle, P.Left, P.Top, dHeight, dWidth, True);
except
Result := False;
end;
Result := True;
end;
author :Henning Huncke
| Position | Programming Language | Ratings | (Ratings) | Status | |
|---|---|---|---|---|---|
| 1 | C | 19.368% | +1.08% | A | |
| 2 | Java | 18.569% | +1.03% | A | |
| 3 | Perl | 10.371% | -0.01% | A | |
| 4 | C++ | 9.722% | -2.83% | A | |
| 5 | PHP | 7.974% | -0.74% | A | |
| 6 | (Visual) Basic | 6.778% | -3.63% | A | |
| 7 | Delphi/Kylix | 2.890% | -0.51% | A | |
| 8 | Python | 2.802% | -3.78% | A | |
| 9 | C# | 2.783% | +1.14% | A | |
| 10 | SQL | 2.650% | +0.37% | A | |
| 11 | JavaScript | 1.387% | -0.06% | A | |
| 12 | COBOL | 1.381% | +0.86% | A | |
| 13 | IDL | 1.226% | +0.91% | A- | |
| 14 | SAS | 1.089% | +0.38% | A | |
| 15 | Lisp | 0.861% | +0.50% | A | |
| 16 | Fortran | 0.818% | +0.45% | A | |
| 17 | MATLAB | 0.780% | +0.51% | A-- | |
| 18 | Ada | 0.679% | +0.34% | B | |
| 19 | Pascal | 0.486% | +0.07% | B | |
| 20 | AWK | 0.475% | +0.21% | B |
|
Extension |
File Type and Description |
Creation Time |
Required to Compile? |
|---|---|---|---|
|
.BMP, .ICO, .CUR |
Bitmap, icon, and cursor files: standard Windows files used to store bitmapped images. |
Development: Image Editor |
Usually not, but they might be needed at run time and for further editing. |
|
.BPG |
Borland Project Group: the files used by the new multiple-target Project Manager. It is a sort of makefile. |
Development |
Required to recompile all the projects of the group at once. |
|
.BPL |
Borland Package Library: a DLL including VCL components to be used by the Delphi environment at design time or by applications at run time. (These files used a .DPL extension in Delphi 3.) |
Compilation: Linking |
You'll distribute packages to other Delphi developers and, optionally, to endusers. |
|
.CAB |
The Microsoft Cabinet compressed-file format used for web deployment by Delphi. A CAB file can store multiple compressed files. |
Compilation |
Distributed to users. |
|
.CFG |
Configuration file with project options. Similar to the DOF files. |
Development |
Required only if special compiler options have been set. |
|
.DCP |
Delphi Compiled Package: a file with symbol information for the code that was compiled into the package. It doesn't include compiled code, which is stored in DCU files or in the BPL file. |
Compilation |
Required when you use run-timepackages. You'll distribute it only to other developers along with BPL files. You can compile an application with the units from a package just by having theDCP file and the BPL (and no DCU files). |
|
.DCU |
Delphi Compiled Unit: the result of the compilation of a Pascal file. |
Compilation |
Only if the source code is not available. DCU files for the units you write are an intermediate step, so they make compilation faster. |
|
.DDP |
The Delphi Diagram Portfolio, used by the Diagram view of the editor (was .DTI in Delphi 5) |
Development |
No. This file stores "design-time only" information, not required by the resulting program but very important for the programmer. |
|
.DFM |
Delphi Form File: a binary file with the description of the properties of a form (or a data module) and of the components it contains. |
Development |
Yes. Every form is stored in both a PAS and a DFM file. |
|
.~DF |
Backup of Delphi Form File (DFM). |
Development |
No. This file is produced when you save a new version of the unit related to the form and the form file along with it. |
|
.DFN |
Support file for the Integrated Translation Environment (there is one DFN file for each form and each target language). |
Development (ITE) |
Yes (for ITE). These files contain the translated strings that you edit in the Translation Manager. |
|
.DLL |
Dynamic link library: another version of an executable file. |
Compilation: Linking |
See .EXE. |
|
.DOF |
Delphi Option File: a text file with the current settings for the project options. |
Development |
Required only if special compiler options have been set. |
|
.DPK and now also .DPKW and .DPKL |
Delphi Package: the project source code file of a package (ora specific project file for Windows or Linux). |
Development |
Yes. |
|
.DPR |
Delphi Project file. (This file actually contains Pascal sourcecode.) |
Development |
Yes. |
|
.~DP |
Backup of the Delphi Project file(.DPR). |
Development |
No. This file is generated auto-matically when you save a new version of a project file. |
|
.DSK |
Desktop file: contains infor-mation about the position of the Delphi windows, the files open in the editor, and other Desktop settings. |
Development |
No. You should actually delete it if you copy the project to a new directory. |
|
.DSM |
Delphi Symbol Module: stores all the browser symbol information. |
Compilation (but only if the Save Symbols option is set) |
No. Object Browser uses this file, instead of the data in memory, when you cannot recompile a project. |
|
.EXE |
Executable file: the Windows application you've produced. |
Compilation: Linking |
No. This is the file you'll distribute. It includes all of the compiled units, forms, and resources. |
|
.HTM |
Or .HTML, for Hypertext Markup Language: the file format used forInternet web pages. |
Web deployment of an ActiveForm |
No. This is not involved in the project compilation. |
|
.LIC |
The license files related to an OCX file. |
ActiveX Wizard and other tools |
No. It is required to use the control in another development environment. |
|
.OBJ |
Object (compiled) file, typical of the C/C++ world. |
Intermediate compilation step, generally not used in Delphi |
It might be required to merge Delphi with C++ compiled code ina single project. |
|
OCX |
OLE Control Extension: a special version of a DLL, containing ActiveX controls or forms. |
Compilation: Linking |
See .EXE. |
|
.PAS |
Pascal file: the source code of aPascal unit, either a unit related to a form or a stand-alone unit. |
Development |
Yes. |
|
.~PA |
Backup of the Pascal file (.PAS). |
Development |
No. This file is generated automatically by Delphi when you save a new version of the source code. |
|
.RES, .RC |
Resource file: the binary file associated with the project and usually containing its icon. You can add other files of this type to a project. When you create custom resource files you might use also the textual format, .RC. |
Development Options dialog box. The ITE (Integrated Translation Environment) gene-rates resource files with special comments. |
Yes. The main RES file of an application is rebuilt by Delphi according to the information in the Application page of the Project Options dialog box. |
|
.RPS |
Translation Repository (part of the Integrated Translation Environment). |
Development (ITE) |
No. Required to manage the translations. |
|
.TLB |
Type Library: a file built automatically or by the Type Library Editor for OLE server applications. |
Development |
This is a file other OLE programs might need. |
|
TODO |
To-do list file, holding the items related to the entire project. |
Development |
No. This file hosts notes for the programmers. |
|
.UDL |
Microsoft Data Link. |
Development |
Used by ADO to refer to a data provider. Similar to an alias in the BDE world (see |
نویسنده:Joel Fugazzotto
procedure AddFarsiLNG;
var Vreg:TRegistry;
//(C) Koosha System Software http://delphi-center.blogfa.com
begin
//Copy Files
CopyFile('l_intl.nls','C:\windows\system32\l_intl.nls',true);
CopyFile('KBDFA.dll','C:\windows\system32\KBDFA.dll',true);
//Create Registry Values
Vreg:=TRegistry.Create;
with Vreg do
begin //(C) Koosha System Software http://delphi-center.blogfa.com
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layouts\00000429',true);
WriteString('Layout File','KBDFA.dll');
WriteString('Layout Text','Farsi');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Locale',true);
WriteString('d','1');
OpenKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language',true);
WriteString('0429','l_intl.nls');
CloseKey; //(C) Koosha System Software http://delphi-center.blogfa.com
finally Free end;
end;
end;
با این کد می توانید تعیین کنید که آیا هر یک از اجزای Office در حال اجرا می باشند یا خیر
uses
ComObj, ActiveX;
function IsObjectActive(ClassName: string): Boolean;
var
ClassID: TCLSID;
Unknown: IUnknown;
begin
try
ClassID := ProgIDToClassID(ClassName);
Result := GetActiveObject(ClassID, nil, Unknown) = S_OK;
except
// raise;
Result := False;
end;
end;
مثال:
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsObjectActive('Word.Application') then ShowMessage('Word is running !');
if IsObjectActive('Excel.Application') then ShowMessage('Excel is running !');
if IsObjectActive('Outlook.Application') then ShowMessage('Outlook is running !');
if IsObjectActive('Access.Application') then ShowMessage('Access is running !');
if IsObjectActive('Powerpoint.Application') then ShowMessage('Powerpoint is running !');
end;
خروجی این فانکشن یک خروجی منطقی است.با این کد می توانید به سادگی تشخیص دهید که سطل زباله خالی است یا پر.
uses
Activex, ShlObj, ComObj;
function RecycleBinIsEmpty: Boolean;
const
CLSID_IRecycleBin: TGUID = (D1: $645FF040; D2: $5081; D3: $101B;
D4: ($9F, $08, $00, $AA, $00, $2F, $95, $4E));
var
EnumIDList: IEnumIDList;
FileItemIDList: PItemIDList;
ItemCount: ULONG;
RecycleBin: IShellFolder;
begin
CoInitialize(nil);
OleCheck(CoCreateInstance(CLSID_IRecycleBin, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IID_IShellFolder, RecycleBin));
RecycleBin.EnumObjects(0,
SHCONTF_FOLDERS or
SHCONTF_NONFOLDERS or
SHCONTF_INCLUDEHIDDEN,
EnumIDList);
Result := EnumIDList.Next(1, FileItemIDList, ItemCount) <> NOERROR;
CoUninitialize;
end;