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

[abc_ramak]

بله متوجه توضیحتون شدم
ولی نمیشه خیلی راحت export کرد؟
همونطور که توی regedit این کارو می کنیم

 

[yasin_d]

مسلما به اون ترتیب نمیشه .
البته اگه یک کامپوننت در این زمینه باشه که احتمالا هست پیدا کردم برات می زارم.

 

[abc_ramak]

مرسی

 

[abc_ramak]

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

 

[abc_ramak]

اینم سوال یه نفر دیگه هست که توی یه فروم دیگه مطرح کرده:

سلام خسته نباشید من یک برنامه نوشتم با بانکهای sql server 2000
مشکل من اینه که هر موقع می خوام برنامه رو اجرا کنم باید اسم کامپیوترمو نامی که
من موقع نوشتن برنامه رو کامپیوترم بوده بدم
می شه لطفا منو تو این رابطه کمکم کنید
خیلی خیلی ممنونم

 

[yasin_d]

کاربر فعال آیا یک ادمین هست

unit WindowsUser;

interface
  uses Windows;

//returns True if the currently logged Windows user has Administrator rights
function IsWindowsAdmin: Boolean;

implementation

const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)) ;

const
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;


function IsWindowsAdmin: Boolean;
var
  hAccessToken: THandle;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdministrators: PSID;
  g: Integer;
  bSuccess: BOOL;
begin
  Result := False;

  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken) ;
  if not bSuccess then
  begin
    if GetLastError = ERROR_NO_TOKEN then
    bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken) ;
  end;


  if bSuccess then
  begin
    GetMem(ptgGroups, 1024) ;

    bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize) ;

    CloseHandle(hAccessToken) ;

    if bSuccess then
    begin
      AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators) ;

      for g := 0 to ptgGroups.GroupCount - 1 do
        if EqualSid(psidAdministrators, ptgGroups.Groups[g].Sid) then
        begin
          Result := True;
          Break;
        end;

      FreeSid(psidAdministrators) ;
    end;

    FreeMem(ptgGroups) ;
  end;
end;

end.

 

[yasin_d]

سلام خسته نباشید من یک برنامه نوشتم با بانکهای sql server 2000
مشکل من اینه که هر موقع می خوام برنامه رو اجرا کنم باید اسم کامپیوترمو نامی که
من موقع نوشتن برنامه رو کامپیوترم بوده بدم
می شه لطفا منو تو این رابطه کمکم کنید
خیلی خیلی ممنونم

کاملتر توضیح بده متوجه نشدم

 

[abc_ramak]

فکر کنم منظورش اینه که وقتی برنامه رو روی کامپیوتر خودش نوشته computer name یه چیزی بوده که الان نیس
حالا هر جا بخواد این برنامه رو اجرا کنه باید از همون computer name برای اون سیستم استفاده کنه

 

[yasin_d]

تست کنم جوابش رو می دم

 

[geek]

سلام دوستان
من چند وقته به یاد گرفتن دلفی علاقه مند شدم
لطفاً شما که در این زمینه کار کردید راهنمایی کنید که چطور دلفی یاد بگیرم
قبلاً یه مقدار c++ کارکردم ولی نه بطور حرفه ای
ممنون میشم اگر ebook هم سراغ دارید برام بذارید

 

[avaaa]

سلام
من اين ترم واسه درس پايگاه تلفيقي از دلفي و sql رو بايد كار كنم و پروژه تحويل بدم ولي هيچي از sql ياد ندارم شما چي پيشنهاد مي كنيد؟؟؟؟؟؟؟؟؟؟/

اين كه شما مهندسا جمع شدين با هم صحبت علمي مي كنين خيلي خوبه ولي ميشه يكيتون لطف كنه و به من صفر كيلومتر هم بگه اين دلفي كه ازش صحبت مي كنين چيه؟

moongirl عزيز اگه ويژوال بيسيك رو ديده باشي دلفي يه چيزي توي مايه هاي همونه ولي با امكانات گرافيكي بيشتر شايد خيلي بيشتر و جالبتر .

 

[mithra]

ماشين حساب مي خوام

 

[yasin_d]

سلام دوستان
من چند وقته به یاد گرفتن دلفی علاقه مند شدم
لطفاً شما که در این زمینه کار کردید راهنمایی کنید که چطور دلفی یاد بگیرم
قبلاً یه مقدار c++ کارکردم ولی نه بطور حرفه ای
ممنون میشم اگر ebook هم سراغ دارید برام بذارید

برای یاد گرفتن دلفی باید به syntax پاسکال آشنا باشی و بعد فقط تمرین... یعنی اینکه یه برنامه خاص رو مثلا کتابخانه رو مشخص کن و بنویسش .
اینکه بخوای بری اول کتاب بخونی بعد کار کنی موثر نیست. در حین انجام پروژه به کتاب مراجعه کن تا مشکلاتت برطرف بشه. اگه مشکلی هم بود اینجا مطرح کنی در خدمتتون هستیم.

سلام
من اين ترم واسه درس پايگاه تلفيقي از دلفي و sql رو بايد كار كنم و پروژه تحويل بدم ولي هيچي از sql ياد ندارم شما چي پيشنهاد مي كنيد؟

1- به جای sql از access استفاده کن.
2- کمی sql یاد بگیر.
معادله پیچیده ای نیست.

ماشين حساب مي خوام

چیز دیگه نمی خوای چایی بستنی میوه قهوه..... ( شوخی کردم به دل نگیر)
به این سایت سر بزن باید پیدا کنی delphi.about.com یا تو گوگل جستجو کن

 

[mina_abasi37]

خسته نباشيد

خسته نباشيد

واقعا خسته نباشيد. خيلي وقت دنبال كسي مي گردم كه بتونه كمكم كنه دلفي ياد بگيرم.حالا يهو اين همه دوستداردلفي پيدا كردم،خيلي خوشحالم.
1-مي خوام بتونم انواع پايگاه داده ها رو به دلفي مرتبط كنم. اگه برام ebook بذاريد يا كتاب معرفي كنيد ممنون مي شم.
2-مي خوام توي دلفي از دستورات sql بخصوص ازselect تو در تو و پارامتري استفاده كنم.ايا امكانش هست؟

 

[yasin_d]

-مي خوام بتونم انواع پايگاه داده ها رو به دلفي مرتبط كنم. اگه برام ebook بذاريد يا كتاب معرفي كنيد ممنون مي شم.

با استفاده از کامپوننت ADOConnection می تونی به بیشتر پایگاه ها وصل شی.

-مي خوام توي دلفي از دستورات sql بخصوص ازselect تو در تو و پارامتري استفاده كنم.ايا امكانش هست؟

با استفاده از کامپوننت ADOQuery می تونی هر نوع query به زبان sql بنویسی.

برای پیشرفت می تونی از کتاب mastering delphi 6 استفاده کنی و بهتر از اون می تونی از course های سایت delphi.about.com استفاده کنی که خیلی کمکت می کنن.

 

[etaranom]

سلام من به یک برنامه ماشین حساب دلفی نیاز دارم که فقط 4 عمل اصلی رو انجام بده و یک دکمه cداشته باشه خیلی روش کار کردم ولی جواب نمیده ممنون میشم شما کمکم کنید البته خیلی سریع

 

[abc_ramak]

می خوام یه عکس رو توی فتوشاپ باز کنم
میشه از shellExecute استفاده کرد و open with کرد؟
من که نتونستم
راه دیگه ای هم هست؟

 

[abc_ramak]

ShellExecute(hwnd(nil),'open','filename',nil,'filedirectory',0);

از این کد برای اجرای فایل استفاده می کنم
ولی پارامتراش نمی دونم هر کدوم به چه درد می خورن
توی help هم نیس

 

[abc_ramak]

فکر کنم باید از TFileOpenWith توی actionlist استفاده کنم
ولی بلد نیستم
آخه من چرا هیچی بلد نیستم

 

[abc_ramak]

ليست تمام فايلهاي موجود در يك دايركتوري

ليست تمام فايلهاي موجود در يك دايركتوري

procedure ListFileDir(Path: string; FileList: TStrings); 
var 
  SR: TSearchRec; 
begin 
  if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then 
  begin 
    repeat 
      if (SR.Attr <> faDirectory) then 
      begin 
        FileList.Add(SR.Name); 
      end; 
    until FindNext(SR) <> 0; 
    FindClose(SR); 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ListFileDir('C:\WINDOWS\', ListBox1.Items); 
end;

 

[abc_ramak]

ليست تمام زيرپوشه هاي يك پوشه اصلي

ليست تمام زيرپوشه هاي يك پوشه اصلي

procedure GetSubDirs(const sRootDir: string; slt: TStrings); 
var 
  srSearch: TSearchRec; 
  sSearchPath: string; 
  sltSub: TStrings; 
  i: Integer; 
begin 
  sltSub := TStringList.Create; 
  slt.BeginUpdate; 
  try 
    sSearchPath := AddDirSeparator(sRootDir); 
    if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then 
      repeat 
        if ((srSearch.Attr and faDirectory) = faDirectory) and 
          (srSearch.Name <> '.') and 
          (srSearch.Name <> '..') then 
        begin 
          slt.Add(sSearchPath + srSearch.Name); 
          sltSub.Add(sSearchPath + srSearch.Name); 
        end; 
      until (FindNext(srSearch) <> 0); 

    FindClose(srSearch); 

    for i := 0 to sltSub.Count - 1 do 
      GetSubDirs(sltSub.Strings[i], slt); 
  finally 
    slt.EndUpdate; 
    FreeAndNil(sltSub); 
  end; 
end;

 

[abc_ramak]

تغيير نام يك دايركتوري

تغيير نام يك دايركتوري

uses 
  ShellApi; 

procedure RenameDir(DirFrom, DirTo: string); 
var 
  shellinfo: TSHFileOpStruct; 
begin 
  with shellinfo do 
  begin 
    Wnd    := 0; 
    wFunc  := FO_RENAME; 
    pFrom  := PChar(DirFrom); 
    pTo    := PChar(DirTo); 
    fFlags := FOF_FILESONLY or FOF_ALLOWUNDO or 
              FOF_SILENT or FOF_NOCONFIRMATION; 
  end; 
  SHFileOperation(shellinfo); 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  RenameDir('C:\Dir1', 'C:\Dir2'); 
end;

 

[abc_ramak]

تعيين فضاي آزاد ديسك

تعيين فضاي آزاد ديسك

procedure TForm1.Button1Click(Sender: TObject); 
var 
freeSpace, totalSpace: Double; 
s: Char; 
begin 
// Drive letter 
// Laufwerksbuchstabe 
s := 'D'; 
 
freeSpace := DiskFree(Ord(s) - 64); 
totalSpace := DiskSize(Ord(s) - 64); 
 
label1.Caption := Format('Free Space: %12.0n', [freeSpace]); 
Label2.Caption := Format('Total Space: %12.0n', [totalSpace]); 
Label3.Caption := IntToStr(Round((totalSpace - freeSpace) / totalSpace * 100)) + 
' Percent used.'; 
end;

 

[abc_ramak]

سايز يك دايركتوري

سايز يك دايركتوري

function GetDirSize(dir: string; subdir: Boolean): Longint; 
var 
rec: TSearchRec; 
found: Integer; 
begin 
Result := 0; 
if dir[Length(dir)] <> '\' then dir := dir + '\'; 
found := FindFirst(dir + '*.*', faAnyFile, rec); 
while found = 0 do 
begin 
Inc(Result, rec.Size); 
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then 
Inc(Result, GetDirSize(dir + rec.Name, True)); 
found := FindNext(rec); 
end; 
FindClose(rec); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
label1.Caption := FloatToStr(GetDirSize('e:\download', False) / Sqr(1024)) + ' MBytes'; 
label2.Caption := FloatToStr(GetDirSize('e:\download', True) / Sqr(1024)) + ' MBytes'; 
end;

 

[abc_ramak]

يافتن فايل در تمام شاخه و زير شاخه هايش:

يافتن فايل در تمام شاخه و زير شاخه هايش:

function  FindFile(Path,Files:String):TStrings;
Var
  Dirs,Fill:String;
  IO,len,i:Integer;
  Search:TsearchRec;
Begin
Result:=TStringList.Create;
If Path='' then exit;
//While Pos(';',files)>0 do
//  Files[Pos(';',Files)]:=' ';       //****
Dirs:='';
If Path[Length(Path)]='\' then
  Delete(path,length(path),1);
Repeat
  I:=Length(Files);
  Repeat
    Fill:='';
    While (I>0) and (files[i]<>';') do //' ') do     //******
      Begin
        Fill:=files[i]+Fill;
        I:=i-1;
      end;
    I:=i-1;
    IO:=findFirst(path+'\'+fill,faAnyFile-faDirectory,Search);
    While Io=0 do
    Begin
      If (search.Name<>'.') and (search.name<>'..') then
        Result.Add(path+'\'+Search.name);
      IO:=FindNext(Search);
    end;
    FindClose(search);
  until I<1;
  IO:=FindFirst(Path+'\*.*',faAnyFile,Search);
  While IO=0 do
  Begin
      If (search.Name<>'.') and (search.name<>'..') and (search.Attr and FaDirectory>0) then
        Dirs:=Dirs+Path+'\'+Search.Name+#13;
      Io:=FindNext(search);
  end;
  FindClose(search);
  Len:=length(Dirs)-1;
  Io:=len;
  If Len>0 then
    Begin
      While (IO>0) and (Dirs[IO]<>#13) do Io:=IO-1;
      Path:=Copy(Dirs,IO+1,Len-IO);
      SetLength(Dirs,IO);
    end;
Until(len<0);
end;

 

[abc_ramak]

همه اینا رو از http://forum.p30world.com پیدا کردم
برای خودم که جالب بودن

 

[abc_ramak]

می خوام یه عکس رو توی فتوشاپ باز کنم
میشه از shellExecute استفاده کرد و open with کرد؟
من که نتونستم
راه دیگه ای هم هست؟

ShellExecute(hwnd(nil),'open','filename',nil,'filedirectory',0);

از این کد برای اجرای فایل استفاده می کنم
ولی پارامتراش نمی دونم هر کدوم به چه درد می خورن
توی help هم نیس

فکر کنم باید از TFileOpenWith توی actionlist استفاده کنم
ولی بلد نیستم
آخه من چرا هیچی بلد نیستم

خودم پیداش کردم

ShellExecute(hwnd(nil),'open','2.exe','f:\1.bmp','d:\',1);

'2.exe' همون برنامه فتوشاپ هست
'f:\1.bmp' عکسی که می خوام بدم به فتوشاپ
'd:\' مسیر برنامه فتوشاپ
اون 1 آخر هم مربوط به minimize و اینجور چیزاس که می تونه عدد های دیگه باشه (خیلی مهم نیس، خود برنامه رو عشقه )

هیچ جا ننوشته بوداااا
خودم کشفش کردم

 

[yasin_d]

آفرین ramak اگه همینطوری ادامه بدی یه دلفی کار خوب می شی

 

[n.ziyayi_88]

سلام من این ترم درس مباحث ویژه برداشتم و استادمون دلفی باهامون کار میکنه .
اگه پروژه خوبی داری میشه خواهش کنم در موردش کمی توضیح بدی .
ممنون میشم.

 

[n.ziyayi_88]

سلام رامک عزیز میشه در رابطه با دلفی بیشتر باهم صحبت کنیم. آخه من 2واحد دلفی دارم.
ممنون میشم. خداحافظ.