-
فرستادن فایل به سطل آشغال
uses ShellAPI;
function DeleteFileWithUndo(sFileName: string): Boolean;
var
fos: TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc := FO_DELETE;
pFrom := PChar(sFileName);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result := (0 = ShFileOperation(fos));
end;
-
1 ضمیمه
دریافت شماره سریال هارد - cpu و ...
دریافت شماره سریال هارد - cpu و ...
مناسب برای ساخت قفل نرم افزاری
-
1 ضمیمه
جابجایی کنترلهای روی فرم در ران تیم
جابجایی کنترلهای روی فرم در ران تیم
-
1 ضمیمه
Gradient-Panel with 6 Main-Propertys
Gradient-Panel with 6 Main-Propertys
-
نقل قول: نکات برنامه نویسی در دلفی
با سلام و تشكر
لطفا مثال در زمينه كار با سوكت ها را هم قرار دهيد
-
نقل قول: نکات برنامه نویسی در دلفی
سلام .
با یه مشکلی مواجه شده بودم که بعد از کلی جستجو و کلنجار رفتم تونستم راه حلش رو پیدا کنم و گفتم اینجا قرار بدم شاید به درد کسی بخوره .
موضوع در رابطه با تبدیل یک مقدار از نوع string به Pwidechar هست( تبدیل به Pwidechar هست نه Widechar ) که در برخی توابع از جمله تابع SetFileAttributes استفاده میشه که برای تبدیل باید از تابع StringToOleStr استفاده کرد .
-
نقل قول: نکات برنامه نویسی در دلفی
روشی ساده برای شناسایی دیباگر
{$IFDEF DEBUG}
ShowMessage('Debuger Found');
{$ENDIF}
-
نقل قول: نکات برنامه نویسی در دلفی
دوست عزیز این کدها مگه راهنمای کامپایلر نیستند؟
اگر در اگزه تست بشه اون پیغام یا هست یا نیست.
فکر نکنم به درد ضد دیباگ در مثلا olly بخوره.
ممکنه توضیح بدید؟
-
نقل قول: نکات برنامه نویسی در دلفی
این کد مربوط به ضد دیباگ نیست و یک راهنمای کامپایلر است که با آن می توانید تشخیص دهید که برنامه توسط دیباگر اجرا شده یا نه؟
از این تکنیک در بسیاری از جاها استفاده میشه و شاید شما هم نظیر آن را در بعضی کامپوننت های Trial دیده باشید که برنامه ساخته شده با آنها فقط در حالت دیباگ می تواند اجرا شود و یا مثلاً می خواهید کاری کنید که اگر برنامه در حالت دیباگ اجرا شد یک Log File تولید کنید و یا ... .
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
دوست عزیز این کدها مگه راهنمای کامپایلر نیستند؟
اگر در اگزه تست بشه اون پیغام یا هست یا نیست.
فکر نکنم به درد ضد دیباگ در مثلا olly بخوره.
ممکنه توضیح بدید؟
بله هست
در exe هم اون پیغام خواهد بود
اتفاقا روی Olly هم تست کردم و جواب داد
-
1 ضمیمه
نقل قول: نکات برنامه نویسی در دلفی
تصحیح کدهای خراب سایت:
Var
S:String;
begin
S:=Memo1.Text;
S:=StringReplace(S,'(','(',[rfReplaceAll]);
S:=StringReplace(S,')',')',[rfReplaceAll]);
S:=StringReplace(S,':',':',[rfReplaceAll]);
S:=StringReplace(S,'[','[',[rfReplaceAll]);
S:=StringReplace(S,']',']',[rfReplaceAll]);
S:=StringReplace(S,'<','<',[rfReplaceAll]);
S:=StringReplace(S,'{','{/',[rfReplaceAll]);
S:=StringReplace(S,'}','/}',[rfReplaceAll]);
Memo1.Text:=S;
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.SelLength:=0;
end;
ضمیمه 86190
-
نقل قول: نکات برنامه نویسی در دلفی
تو این لینک که مربوط به سایت نرم افزار قوی Help & Manual هست نحوه ارتباط با فایل راهنما کامل توضیح داده شده. جهت توسعه هرچه بهتر نرم افزارتون حتما به کار میاد.
راستی نرم افزار Help & Manual رو فراموش نکنید و اینکه با دلفی بزرگوار تولید شده.
صفحه ارتباط با راهنما:
http://www.helpsmith.com/how-to-conn...chm-delphi.php
صفحه اصلی نرم افزار:
http://www.helpsmith.com/
-
نقل قول: نکات برنامه نویسی در دلفی
سلام
همه شما با دستور With آشنایی دارید.
به کد زیر توجه کنید:
with Memo1 do
begin
With Lines do
begin
Add('Line 1');
Add('Line 2');
end;
end;
کد بالا یک معادل جالب هم دارد که شاید افراد بسیاری کمی از آن اطلاع داشته باشند. جالب است بدانید که کد زیر دقیقاً معادل کد بالا است:
with Memo1, Lines do
begin
Add('Line 1');
Add('Line 2');
end;
منبع:
http://www.nickhodges.com/post/How-N...tatements.aspx
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
نوشته شده توسط
شاهین عشایری
سلام
همه شما با دستور With آشنایی دارید.
به کد زیر توجه کنید:
with Memo1 do
begin
With Lines do
begin
Add('Line 1');
Add('Line 2');
end;
end;
کد بالا یک معادل جالب هم دارد که شاید افراد بسیاری کمی از آن اطلاع داشته باشند. جالب است بدانید که کد زیر دقیقاً معادل کد بالا است:
with Memo1, Lines do
begin
Add('Line 1');
Add('Line 2');
end;
منبع:
http://www.nickhodges.com/post/How-N...tatements.aspx
مثالی که ذکر کردید جالب نیست ، خوب به جای اون کد :
with Memo1.Lines do
begin
Add('Line 1');
Add('Line 2');
end;
اون نوع استفاده از with برای اشیاء مختلف کاربردی هست ، مثلا :
var
StrList: TStringList;
I: Integer;
begin
StrList := TStringList.Create;
try
with ListBox1, StrList do
begin
Add('Item 1 in string list');
Add('Item 2 in string list');
Add('Item 3 in string list');
for I := 0 to Count - 1 do
Items.Add(Strings[I]);
end;
finally
StrList.Free;
end;
end;
البته به عنوان مثال و گرنه با Assign میشه راحت این مورد رو پیاده کرد .
از این شیوه در پروژه های بزرگ استفاده نکنید ، کد رو خیلی پیچیده میکنه و به نوشتن کدهای کثیف کمک شایانی میکنه و کار دیباگ کد رو بسیار پیچیده میکنه .
در ضمن اگر اشیاء انتخاب شده دارای متدهای یکسانی باشند متد شئ آخر در لیست With در نظر گرفته میشه ، مثلا تو همون کد بالا هم کلاس TStringList دارای متد Count هست هم کلاس TListBox ، همون کد بالا اگر به صورت زیر نوشته بشه دیگه کار نمیکنه :
var
StrList: TStringList;
I: Integer;
begin
StrList := TStringList.Create;
try
with StrList, ListBox1 do
begin
Add('Item 1 in string list');
Add('Item 2 in string list');
Add('Item 3 in string list');
for I := 0 to Count - 1 do
Items.Add(Strings[I]);
end;
finally
StrList.Free;
end;
end;
چون شئ ListBox1 به عنوان شئ دوم ( آخری ) به With ارجاع داده شده و ListBox1 حاوی هیچ آیتمی نیست و اصلا وارد حلقه نمیشه .
موفق باشید .
-
نمایش Memory Leak در Delphi 2006 به بعد
از قابلیتهایی که در دلفی 2006 و نسخه های جدیدتر وجود دارد ریپورت برای memory leak میباشد.
memory leak هنگامی بوجود می اید که یک شیی بعد از ایجاد و استفاده حافظه تخصیص داده شده به آن آزاد نگردد.
مثال:
var
sl : TStringList;
begin
sl := TStringList.Create;
sl.Add('Memory leak!') ;
end;
در مثال فوق TStringList ایجاد شده بعد از استفاده با دستور sl.free; حافظه تخصیص یافته به آن آزاد نشده است
با استفاده از دستور ReportMemoryLeaksOnShutdown اگر هنگام بسته شدن برنامه memory leak در حافظه وجود داشته باشد پیغام Unexpected Memory Leak به نمایش در خواهد آمد.
begin
ReportMemoryLeaksOnShutdown := DebugHook <> 0;
//source "by" Delphi
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm) ;
Application.Run;
end.
منبع:
http://www.iranled.com/forum/archive...ead-24471.html
-
نقل قول: نکات برنامه نویسی در دلفی
نقل قول:
از قابلیتهای دیگری که به دلفی xe3 اضافه شده ریپورت برای memory leak میباشد
از دلفی 2006 وجود داشت .
اون دایرکتیو inline ی هم که تو اون لینک گفته شده تو نسخه های قبل هم بود ...
-
نقل قول: نکات برنامه نویسی در دلفی
دیدم کار جالبیه گفتم بزارم اینچا : (شایدم واسه من جالب بوده:لبخندساده:)
procedure TForm1.Button1Click(Sender: TObject);
begin
case MessageDlg('Show a Message', mtConfirmation, [mbYes, mbNo], 0) of
mrYes:
ShowMessage('mrYes clickid');
mrNo:
ShowMessage('mrNo clickid');
end;
end;
-
بیش از 6000 نکته و سورس کد برای دلفی
درود به همه من این برنامه رو دانلود کردم تقریباً نصف مشکلاتم رو برطرف میکنه امید وارم برای شما هم مفید واقع بشه
http://delphi.cjcsoft.net/viewthread...extra=page%3D1
موفق باشید.
-
دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
سلام میخوام تمامی کد هایی رو که دارم براتون اینجا قرار بدم لطفا از نوشتن اطلاعات در لابلای پیام ها خود داری کنید و در صورت تمایل به تشکر از دکمه تشکر استفاده کنید
متشکرم
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
ذخيره کردن يک فرم به عنوان يک عکس
bmp: TBitmap;
begin
bmp := TBitmap.Create;
bmp.Height := Form1.Height;
bmp.Width := Form1.Width;
DCWindow := GetWindowDC(Form1.Handle);
BitBlt(bmp.Canvas.Handle, 0, 0, Form1.Width, Form1.Height,
DCWindow, 0, 0, SRCCOPY);
bmp.SaveToFile('C:\ScreenShot.bmp');
ReleaseDC(DCWindow, DCWindow);
bmp.Free;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
محاسبه اختلاف دو ساعت در MaskEdit
MaskEdit3.Text := FormatDateTime('hh:mm', StrToTime(MaskEdit2.Text)-StrToTime(MaskEdit3.Text));
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
افزودن شماره ردیف در یک دیبی گرید
1. create new blank field in dbgrid
2. rename the title with 'No:'
3. put this code in OnDrawColumncell
4. Now your Grid has a row number
}
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if DataSource1.DataSet.RecNo > 0 then
begin
if Column.Title.Caption = 'No:' then
DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top, IntToStr(DataSource1.DataSet.RecNo));
end;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
AutoSize کردن ستون هاي يک DBGrid را براي Fit شدن
procedure SetGridColumnWidths(Grid: Tdbgrid);
const
DEFBORDER = 10;
var
temp, n: Integer;
lmax: array [0..30] of Integer;
begin
with Grid do
begin
Canvas.Font := Font;
for n := 0 to Columns.Count - 1 do
lmax[n] := Canvas.TextWidth(Fields[n].FieldName) + DEFBORDER;
grid.DataSource.DataSet.First;
while not grid.DataSource.DataSet.EOF do
begin
for n := 0 to Columns.Count - 1 do
begin
temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;
if temp > lmax[n] then lmax[n] := temp;
end;
grid.DataSource.DataSet.Next;
end;
grid.DataSource.DataSet.First;
for n := 0 to Columns.Count - 1 do
if lmax[n] > 0 then
Columns[n].Width := lmax[n];
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetGridColumnWidths(dbgrid3);
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
BMP To JPGStream
procedure BMP_To_JPGStream(const Bitmap:TBitmap; Quality:Integer; var AStream:TMemoryStream);
var
JpegImg: TJpegImage;
begin
JpegImg := TJpegImage.Create;
Try
JpegImg.CompressionQuality := Quality;
JpegImg.PixelFormat := jf8Bit;
JpegImg.Assign(Bitmap);
JpegImg.SaveToStream(AStream);
Finally
JpegImg.Free
end;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
[QUOTE]CheckBox در DBGrid /QUOTE]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBTables, Grids, DBGrids;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure DBGrid1CellClick(Column: TColumn);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid1ColEnter(Sender: TObject);
procedure DBGrid1ColExit(Sender: TObject);
private
FOriginalOptions : TDBGridOptions; { Private declarations }
public
procedure SaveBoolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.SaveBoolean;
begin
Self.DBGrid1.SelectedField.Dataset.Edit;
Self.DBGrid1.SelectedField.AsBoolean := not Self.DBGrid1.SelectedField.AsBoolean;
Self.DBGrid1.SelectedField.Dataset.Post;
end;
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
if Self.DBGrid1.SelectedField.DataType = ftBoolean then
SaveBoolean();
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
Const
CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
DFCS_BUTTONCHECK or DFCS_CHECKED);
var
CheckBoxRectangle : TRect;
begin
if Column.Field.DataType = ftBoolean then
begin
Self.DBGrid1.Canvas.FillRect(Rect);
CheckBoxRectangle.Left := Rect.Left + 2;
CheckBoxRectangle.Right := Rect.Right - 2;
CheckBoxRectangle.Top := Rect.Top + 2;
CheckBoxRectangle.Bottom := Rect.Bottom - 2;
DrawFrameControl(Self.DBGrid1.Canvas.Handle,
CheckBoxRectangle,
DFC_BUTTON,
CtrlState[Column.Field.AsBoolean]);
end;
end;
procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
if Self.DBGrid1.SelectedField.DataType = ftBoolean then
begin
Self.FOriginalOptions := Self.DBGrid1.Options;
Self.DBGrid1.Options := Self.DBGrid1.Options - [dgEditing];
end;
end;
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
if Self.DBGrid1.SelectedField.DataType = ftBoolean then
Self.DBGrid1.Options := Self.FOriginalOptions;
end;
end.
اين هم مال فرم
object Form1: TForm1
Left = 192
Top = 114
Width = 953
Height = 778
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 945
Height = 744
Align = alClient
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
OnCellClick = DBGrid1CellClick
OnColEnter = DBGrid1ColEnter
OnColExit = DBGrid1ColExit
OnDrawColumnCell = DBGrid1DrawColumnCell
end
object Table1: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'reservat.db'
Left = 128
Top = 88
end
object DataSource1: TDataSource
DataSet = Table1
Left = 176
Top = 80
end
end
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
Copy/ paste از محتويات Memo
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.PasteFromClipboard;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
ساخت رندم پسورد سخن گو
function SpeakAblePassWord: string;
const
conso: array [0..19] of Char = ('b', 'c', 'd', 'f', 'g', 'h', 'j',
'k', 'l', 'm', 'n', 'p', 'r', 's', 't', 'v', 'w', 'x', 'y', 'z');
vocal: array [0..4] of Char = ('a', 'e', 'i', 'o', 'u');
var
i: Integer;
begin
Result := '';
for i := 1 to 4 do
begin
Result := Result + conso[Random(19)];
Result := Result + vocal[Random(4)];
end;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
disable xp firewal غيره فعال کردن فايروال
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.
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
Download كردن فايل توسط Socket
procedure DownloadFile(strHost, strRemoteFileName, strLocalFileName: string;
ClientSocket: TClientSocket);
var
intReturnCode: Integer;
s: string;
szBuffer: array[0..128] of Char;
FileOut: TFileStream;
begin
if strRemoteFileName[1] <> '/' then
strRemoteFileName := '/' + strRemoteFileName;
FileOut := TFileStream.Create(strLocalFileName, fmCreate);
try
with ClientSocket do
begin
Host := strHost;
ClientType := ctBlocking;
Port := 80;
try
Open;
{send query}
s := 'GET ' + strRemoteFileName + ' HTTP/1.0'#13#10 +
'Host: ' + strHost + #13#10#13#10;
intReturnCode := Socket.SendBuf(Pointer(s)^, Length(s));
if intReturnCode > 0 then
begin
{receive the answer}
{ iterate until no more data }
while (intReturnCode > 0) do
begin
{ clear buffer before each iteration }
FillChar(szBuffer, SizeOf(szBuffer), 0);
{ try to receive some data }
intReturnCode := Socket.ReceiveBuf(szBuffer, SizeOf(szBuffer));
{ if received a some data, then add this data to the result string }
if intReturnCode > 0 then
FileOut.Write(szBuffer, intReturnCode);
end
end
else
MessageDlg('No answer from server', mtError, [mbOk], 0);
Close;
except
MessageDlg('No connection', mtError, [mbOk], 0);
end;
end;
finally
FileOut.Free
end;
end;
// طريقه استفاده
procedure TForm1.Button1Click(Sender: TObject);
begin
DownloadFile('www.geocities.com', '/b_yaghobi/index.html', 'd:\index.html', ClientSocket1);
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
procedure DrawCursor(ScreenShotBitmap : TBitmap);
var
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
r := ScreenShotBitmap.Canvas.ClipRect;
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.Flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
ScreenShotBitmap.Canvas.Draw(
ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left,
ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top,
Icon);
end;
end;
finally
Icon.Free;
end;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
Encrypt / decrypt passwords
const
Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklm nopqrstuvwxyz+/';
function GeneratePWDSecutityString: string;
var
i, x: integer;
s1, s2: string;
begin
s1 := Codes64;
s2 := '';
for i := 0 to 15 do
begin
x := Random(Length(s1));
x := Length(s1) - x;
s2 := s2 + s1[x];
s1 := Copy(s1, 1,x - 1) + Copy(s1, x + 1,Length(s1));
end;
Result := s2;
end;
function MakeRNDString(Chars: string; Count: Integer): string;
var
i, x: integer;
begin
Result := '';
for i := 0 to Count - 1 do
begin
x := Length(chars) - Random(Length(chars));
Result := Result + chars[x];
chars := Copy(chars, 1,x - 1) + Copy(chars, x + 1,Length(chars));
end;
end;
function EncodePWDEx(Data, SecurityString: string; MinV: Integer = 0;
MaxV: Integer = 5): string;
var
i, x: integer;
s1, s2, ss: string;
begin
if minV > MaxV then
begin
i := minv;
minv := maxv;
maxv := i;
end;
if MinV < 0 then MinV := 0;
if MaxV > 100 then MaxV := 100;
Result := '';
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
for i := 1 to Length(SecurityString) do
begin
x := Pos(SecurityString[i], s1);
if x > 0 then s1 := Copy(s1, 1,x - 1) + Copy(s1, x + 1,Length(s1));
end;
ss := securitystring;
for i := 1 to Length(Data) do
begin
s2 := s2 + ss[Ord(Data[i]) mod 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
s2 := s2 + ss[Ord(Data[i]) div 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
end;
Result := MakeRNDString(s1, Random(MaxV - MinV) + minV + 1);
for i := 1 to Length(s2) do Result := Result + s2[i] + MakeRNDString(s1,
Random(MaxV - MinV) + minV);
end;
function DecodePWDEx(Data, SecurityString: string): string;
var
i, x, x2: integer;
s1, s2, ss: string;
begin
Result := #1;
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
ss := securitystring;
for i := 1 to Length(Data) do if Pos(Data[i], ss) > 0 then s2 := s2 + Data[i];
Data := s2;
s2 := '';
if Length(Data) mod 2 <> 0 then Exit;
for i := 0 to Length(Data) div 2 - 1 do
begin
x := Pos(Data[i * 2 + 1], ss) - 1;
if x < 0 then Exit;
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
x2 := Pos(Data[i * 2 + 2], ss) - 1;
if x2 < 0 then Exit;
x := x + x2 * 16;
s2 := s2 + chr(x);
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) - 1);
end;
Result := s2;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
highlight كردن متن درون Twebbrowser
{....}
private
procedure SearchAndHighlightText(aText: string);
{....}
uses mshtml;
{ .... }
procedure TForm1.SearchAndHighlightText(aText: string);
var
tr: IHTMLTxtRange; //TextRange Object
begin
if not WebBrowser1.Busy then
begin
tr := ((WebBrowser1.Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange;
//Get a body with IHTMLDocument2 Interface and then a TextRang obj. with IHTMLBodyElement Intf.
while tr.findText(aText, 1, 0) do //while we have result
begin
tr.pasteHTML('<span style="background-color: Lime; font-weight: bolder;">' +
tr.htmlText + '</span>');
//Set the highlight, now background color will be Lime
tr.scrollIntoView(True);
//When IE find a match, we ask to scroll the window... you dont need this...
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
SearchAndHighlightText('delphi');
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
...
type
TMessageList = class(TList);
var
Form1: TForm1;
MessageList: TMessageList = nil;
MessageBuffer: TEventMsg;
HookHandle: hHook = 0;
MessageCount: Word = 0;
Go: Boolean = False;
Pan: array[0..5] of TPanel;
implementation
{$R *.DFM}
procedure Stop;
begin
if Go then UnHookWindowsHookEx(HookHandle);
MessageList.Free;
Go:=False;
end;
function FBack(Code: Integer; wParam, lParam: LongInt): LongInt; stdcall;
begin
Inc(MessageCount);
Randomize;
if MessageCount>=MessageList.Count then Stop
else MessageBuffer:=TEventMsg(MessageList.Items[MessageCount]^);
Result:=CallNextHookEx(HookHandle, Code, wParam, lParam);
Pan[MessageCount].Color:=RGB(Random(255), Random(255), Random(255))
end;
procedure SetHook;
begin
MessageBuffer:=TEventMsg(MessageList.Items[0]^);
MessageCount:=0;
HookHandle:=SetWindowsHookEx(WH_MOUSE, FBack, hInstance, 0);
Go:=True;
end;
procedure MakeMessage(Mes: Cardinal);
var
MyEvent: PEventMsg;
begin
New(MyEvent);
with MyEvent^ do
begin
message:=Mes;
ParamL:=50;
ParamH:=50;
Time:=GetTickCount;
hWnd:=Form1.Handle;
end;
MessageList.Add(MyEvent);
end;
function SendMouse: Integer;
begin
try
MessageList:=TMessageList.Create;
MakeMessage(WM_RBUTTONDOWN);
MakeMessage(WM_RBUTTONUP);
SetHook; // set hook
except
end;
Result:=0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Pan[1]:=Panel1;
Pan[2]:=Panel2;
SendMouse;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
Map كردن درايوهاي شبكه
WNetConnectionDialog(0,RESOURCETYPE_DISK );
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
function md5(const Input: String): String;
var
hCryptProvider: HCRYPTPROV;
hHash: HCRYPTHASH;
bHash: array[0..$7f] of Byte;
dwHashBytes: Cardinal;
pbContent: PByte;
i: Integer;
begin
dwHashBytes := 16;
pbContent := Pointer(PChar(Input));
Result := '';
if CryptAcquireContext(@hCryptProvider, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_MACHINE_KEYSET) then
begin
if CryptCreateHash(hCryptProvider, CALG_MD5, 0, 0, @hHash) then
begin
if CryptHashData(hHash, pbContent, Length(Input) * sizeof(Char), 0) then
begin
if CryptGetHashParam(hHash, HP_HASHVAL, @bHash[0], @dwHashBytes, 0) then
begin
for i := 0 to dwHashBytes - 1 do
begin
Result := Result + Format('%.2x', [bHash[i]]);
end;
end;
end;
CryptDestroyHash(hHash);
end;
CryptReleaseContext(hCryptProvider, 0);
end;
Result := AnsiLowerCase(Result);
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
minimize كردن كليه پنجره ها
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function EnumWinProc(Wnd : HWND) : Boolean; Export; StdCall;
var
WinText : Array[0..255] of Char;
begin
GetWindowText(Wnd, WinText, 255);
Result := True;
if (StrPas(WinText) <> '') and
IsWindowVisible(Wnd) and
(Wnd<>Application.Handle) and
(Wnd<>Form1.Handle)
then
CloseWindow(Wnd);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWinProc, LongInt(Self));
end;
end.
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
MultiSelect كردن در DBGrid
procedure TForm1.Button1Click(Sender: TObject);
var
X: Word;
TempBookmark: TBookMark;
begin
with DBGrid1.DataSource.DataSet do
begin
DisableControls;
with DBGrid1.SelectedRows do
if Count<>0 then
begin
TempBookmark:=GetBookmark;
for X:=0 to Count-1 do
begin
if IndexOf(Items[X])>-1 then
begin
Bookmark:=Items[X];
ShowMessage(Fields[1].AsString);
end;
end;
end;
GotoBookmark(TempBookmark);
FreeBookmark(TempBookmark);
EnableControls;
end;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
print گرفتن فايل Word از داخل برنامه
var
oWord : TWordApplication;
varFileName : OleVariant;
begin
oWord := TWordApplication.Create (Nil);
Try
oWord.Connect;
varFileName := 'c:\temp\test.doc';
oWord.Documents.Open (varFileName,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam);
oWord.ActiveDocument.PrintOut (EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam);
oWord.Disconnect;
Finally
oWord.Free;
End;
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
Register a OCX File
uses
OLECtl;
var
OCXHandle: THandle;
RegFunc: TDllRegisterServer;
begin
OCXHandle := LoadLibrary ('C:\Windows\System\custom.ocx');
RegFunc := GetProcAddress (OCXHandle, 'DllRegisterServer');
if RegFunc <> 0 then
ShowMessage('Error!');
FreeLibrary (OCXHandle);
end;
-
نقل قول: دریافت کد های برنامه نویسی از پیش نوشته شده برای دلفی
نقل قول:
ScreenShot عکس گرفتن از صفحه نمايش
procedure ScreenShot(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap);
var
dc: HDC; lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then
begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries :=GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEn try);
if (lpPal^.PalNumEntries <> 0) then
begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SR CCOPY);
{release the screen dc}
ReleaseDc(0, dc);
end;