مشروع مافكسبي2003

السلام عليكم

ما شاء الله أخ زكيري مشروع جميل جدا

كنت عاوز

اشارك معك لكن الظاهر مليش ملح مع المعلمين :blush:

سأحاول أن أشارك من بعيد بما أقدر عليه :happy:

بالتوفيق إن شاء الله

هنا سيتم طرح كل الاشكالت و اراء الاخوة ومناقشة اي كل ما يتعلق بالمشروع وفي اموضوع الاخر لا نكتب الا الاكواد الصحيحة كي يستطيع القارء تتبع المشروع و تجريبه

اقتباس

اشارك معك لكن الظاهر مليش ملح مع المعلمين

سأحاول أن أشارك من بعيد بما أقدر عليه

rober

ستشارك المشروع سهل في 50% وصعب 50% شارك في السهل

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

اقتباس

أما بالنسبه للمشاركه فأنا لا أعمل بالدلفي للأسف.. لكن سأحاول في أي شئ عام ويمكنني المشاركه ب

إن شاء الله سيتم تحويل كل جزء ننهيه من الدلفي الى الدلفي نت وكما تعلم انه يشبه كثيرا c# vb.net

وهنا مشاركتك ضرورية وبارك الله فيك

أخ زكيري بعون الله أحاول أن أشارك بما أستطيع

ممكن مثلا أستعمال الريجيستري فعندي خلفية بسيطة بالتعامل معها

و أحاول أشوف البارادوكس

لا أستطيع أن أرفض طلب لشخص أكن له كل الأحترام :blush:

و الله المستعان

1- جمع الوظائف و الإجراءات

أ)-الوظائف الخاصة بالملفات الفهارس 'الدليل"

*-: وظيفة من نوع منطقي ترجع القيمة صحيج ان تم اشاء الدليل الممر في المتغيرة iFld

function CreatFolder(iFld:string): boolean;

*-: وظيفة من نوع منطقي ترجع القيمة صحيج ان تم نسخ كل ملفات الدليل و الفهارس الجزئية

function CopyFolder(FromFld, ToFld: string): boolean;

*-: وظيفة من نوع منطقي ترجع القيمة صحيج ان تم حذف الدليل وكل محتوياته

function DelFolder(iFld: String): Boolean;

*-: وظيفة من نوع منطقي ترجع القيمة صحيج ان تم التأكد من ان الدليل فارغ

Function IsEmptyFolder(iFld:string):Boolean;

*-:وظيفة من نوع عدد صحيح ترجع عدد الملفات التي تم نسخها في المجلد الصحيح

Function CopyAllFile(FromFld, ToFld:string):integer;

اخي زكيري عبد العالي عندي إقتراح :

لماذا لاتتعامل مع الـ Unicode وهكذا يمكن تفادي اخطاء :

من مثل :

لايمكن فتح الدليل : مجلدي\:C

اعني ان تسمية الدليل /الملف يمكن ان تكون بغير Ansi

اقتباس

function CopyFolder(FromFld, ToFld: string): boolean;

function CopyFolder(FromFld, ToFld: WideString): boolean;

مجرد إقتراح

بارك الله فيك اخي mohfa لكن هذه المرحة الرابعة وفيها سنقوم بكل التعديلات بحول الله

سأضع اسمك مع الفريق الخاص بالمراقبة و تصحيح وتعديل النقائص

شكرا للمشاركة اذن

اريد اسماء للفريق الخاص بالمرحة الاولى و الثانية .

1- المرحلة الاولى

ايجاد الكود اللزم لفعل ما وضعته في قاءمه الوظائف

الكل يشارك مبتدأ متوسط او محترف

2- المرحلة 2

انشاء واجهة المشروع

مبرج خاص بانشاء الفورمات و المكونات اللزمه

منشأ الصور له الخبرة الصغيرة في البحث و انشاء واجة الغرافيكية للمشروع

شخصين مبتدئين

اعتقد انها المرحلة البسيط و مضى يوم ولم اري اي مشارك ولو بكود صغير و حتي ان كان خاطئ المهم المشاركة و كم هو سهل اجاد المطلوب من الانترنت , لما الانتضار وخاصة وان لي الوقت هذه الايام.

شكرا

اخي عبد العالي اول مشاركة لي في المشروع:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ShellApi;
type
TOperationMode = (omCreatFld{Create Folder },omCopyFld{Copy from folder},omDelFld{Delete folder},omIsEmptyFld{is folder empty});
  TFrmMain = class(TForm)
	GroupBox1: TGroupBox;
	CreatFldBtn: TButton;
	CopyFldBtn: TButton;
	DelFldBtn: TButton;
	IsEmptyFldBtn: TButton;
	procedure CreatFldBtnClick(Sender: TObject);
	procedure CopyFldBtnClick(Sender: TObject);
	procedure DelFldBtnClick(Sender: TObject);
	procedure IsEmptyFldBtnClick(Sender: TObject);
  private
	{ Private declarations }
	iNewFld,
	iToFld ,
	iDir,
	fSource,
	fTarget:String;
	isCreated,
	isCopied,
	isDeleted,
	isEmpty:Boolean;
	fOperationMode :TOperationMode;
	procedure SetOperationMode(Value:TOperationMode);
	property Operation: TOperationMode read fOperationMode write SetOperationMode;
	function DelFolder(iFld: String): Boolean;
	Function IsEmptyFolder(iFld:string):Boolean;
	function CopyFolder(FromFld, ToFld: string): boolean;
	function CreatFolder(iFld:string): boolean;

  public
	{ Public declarations }
  end;

var
  FrmMain: TFrmMain;
  const fLdName : array [0..3] of String =('NewTest','c:\test','C:\target','C:\test\*.*');
  {
  NewTest = This is the New folder that will be created in c:\test
  c:\test = The origin of all folders and operations test
  C:\target = Will be used as a Terget folder when copying from  C:\test\*.*
  C:\test\*.* = Will be used as a Source  when copying to C:\target
  }
implementation

{$R *.dfm}

procedure TFrmMain.SetOperationMode(Value: TOperationMode);

begin
if Value = omCreatFld then begin
// Create The Folder NewTest in the c:\test
iNewFld:=fLdName[0];//'NewTest';
iToFld:= IncludeTrailingBackslash(fLdName[1]{c:\test})+iNewFld;
If DirectoryExists(iToFld) then begin
Application.MessageBox(Pchar(format('Folder : " %s " already exits ',[iNewFld])), 'Folder Create!', MB_ICONERROR);
Exit;
end;
isCreated:=CreatFolder(iToFld);
if isCreated then
Application.MessageBox(PChar(Format('Folder : " %s "  Was successfully created in : " %s " ',[iNewFld,ExtractFilePath(iToFld)])), 'Folder Create!', MB_ICONINFORMATION)
else
Application.MessageBox(Pchar(format('Error in creating the : " %s " folder ',[iNewFld] )), 'Folder Create !', MB_ICONERROR);
end else
if Value =omCopyFld then begin
// Copy  The content(s) / subFolder(s) to C:\target
fSource:=fLdName[3]; // C:\test\*.*
fTarget:=fLdName[2]; // C:\target
If (Not(DirectoryExists(fSource)or(not(DirectoryExists(fTarget))))) then begin
Application.MessageBox(Pchar(format('Source Folder : " %s "  OR  Target Folder : " %s "  does not exit ',[ExtractFilePath(fSource),fTarget])), 'Copy from Folder!', MB_ICONERROR);
Exit;
end;
isCopied:=CopyFolder(fSource,fTarget);
if isCopied Then
Application.MessageBox(PChar(Format('All Contents of : " %s "  Were copied to : " %s " ',[ExtractFilePath(fSource),fTarget])), 'Copy from Folder!', MB_ICONINFORMATION)
else
Application.MessageBox(Pchar(format('Error in copying from : " %s "  to : " %s "',[ExtractFilePath(fSource),fTarget] )), 'Copy from Folder!', MB_ICONERROR);
end else
if Value =omDelFld then begin
// Delete c:\test and  all its Content(s) / subFolders
iDir:=fLdName[1];//c:\test
If Not DirectoryExists(iDir) then begin
Application.MessageBox(Pchar(format('Folder : " %s " does not exit ',[iDir])), 'Folder Delete!', MB_ICONERROR);
Exit;
end;
isDeleted:=DelFolder(iDir);
If isDeleted then
Application.MessageBox(PChar(Format('Folder : " %s "  and all its contents were deleted ',[iDir])), 'Folder Delete!', MB_ICONINFORMATION)
else
Application.MessageBox(Pchar(format('Error in deleting : " %s "',[iDir] )), 'Folder Delete!', MB_ICONERROR);
end else
if Value =omIsEmptyFld then begin
iDir :=fLdName[1]; // c:\test
If Not DirectoryExists(iDir) then begin
Application.MessageBox(Pchar(format('Folder : " %s " does not exit ',[iDir])), 'Is Folder Empty!', MB_ICONERROR);
Exit;
end;
isEmpty := IsEmptyFolder(iDir);
If isEmpty then
Application.MessageBox(PChar(Format('Folder : " %s " is empty ',[iDir])), 'Is Folder Empty!', MB_ICONINFORMATION)
else
Application.MessageBox(Pchar(format('Folder : " %s " is not empty ',[iDir])), 'Is Folder Empty!', MB_ICONERROR);
end;
fOperationMode:=Value;
end;
function TFrmMain.DelFolder(iFld: String): Boolean;
var searchRec:TsearchRec;
	searchResult:integer;
begin
Result:=False;
if Not sysutils.DirectoryExists(iFld)then exit;
  searchResult:=findFirst(iFld+'\*.*',faDirectory,searchRec);
  try
	while (0=searchResult) do
	begin
	  if ((searchRec.attr and faDirectory)>0) then
	  begin
		if (searchRec.name<>'.') and (searchRec.name<>'..') then
		  DelFolder(iFld+'\'+searchRec.Name)
	  end
	  else
		deleteFile(iFld+'\'+searchRec.Name);
	  searchResult:=findNext(searchRec);
	end;
  finally
	findClose(searchRec);
  end;
  Result:=removeDir(iFld)=True;
end;
Function TFrmMain.IsEmptyFolder(iFld:string):Boolean;
var
  searchRec :TSearchRec;
begin


try
   result := (FindFirst(iFld+'\*.*', faAnyFile, searchRec) = 0) AND
			 (FindNext(searchRec) = 0) AND
			 (FindNext(searchRec) <> 0);
  finally
	FindClose(searchRec);
  end;
end;

function TFrmMain.CopyFolder(FromFld, ToFld: string): boolean;
var
 fOS:TSHFileOpStruct;
begin
if Not DirectoryExists(ToFld) Then ForceDirectories(ToFld);
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
	wFunc := FO_COPY;
	//fFlags := FOF_FILESONLY;
	fFlags:=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION or FOF_SILENT;
	pFrom := PChar(FromFld + #0);
	pTo := PChar(ToFld);
  end;
  Result := (0 = ShFileOperation(fOS));
end;
function TFrmMain.CreatFolder(iFld:string): boolean;
begin
Result:=Not(DirectoryExists(iFld)) and ForceDirectories(iFld)=True;
end;
procedure TFrmMain.CreatFldBtnClick(Sender: TObject);
begin
Operation:=omCreatFld; // Create Folder
end;
procedure TFrmMain.CopyFldBtnClick(Sender: TObject);
begin
Operation:=omCopyFld;  // Copy Folder / Contents
end;
procedure TFrmMain.DelFldBtnClick(Sender: TObject);
begin
Operation:=omDelFld;  // Delete Folder / Contenets
end;
procedure TFrmMain.IsEmptyFldBtnClick(Sender: TObject);
begin
Operation:=omIsEmptyFld; // Is it Empty
end;
end.

Project1.zip

بارك الله فيك على المحاولت الناجحه الجيدة جدا

وانا افترح هذا

[color= #000000; font-weight: bold;]function DelFolder[color= #009900;](iFld[color= #339933;]: String[color= #009900;])[color= #339933;]: Boolean[color= #339933;];

[color= #000000; font-weight: bold;]var fos[color= #339933;]: TSHFileOpStruct[color= #339933;];

begin

  ZeroMemory[color= #009900;]([color= #339933;]@fos[color= #339933;], [color= #990000;]SizeOf[color= #009900;](fos[color= #009900;])[color= #009900;])[color= #339933;];

  with fos [color= #b1b100;]do begin

    wFunc [color= #339933;]:= FO_DELETE[color= #339933;];

    fFlags [color= #339933;]:= FOF_SILENT or FOF_NOCONFIRMATION[color= #339933;];

    pFrom [color= #339933;]:= PChar[color= #009900;](iFld [color= #339933;]+ [color= #666666; font-style: italic;]#0);

  [color= #990000;]end[color= #339933;];

  Result [color= #339933;]:= [color= #009900;]([color= #cc66cc;]0[color= #339933;]=ShFileOperation[color= #009900;](fos[color= #009900;])[color= #009900;])[color= #339933;];

[color= #990000;]end[color= #339933;];

ايضا يجب اضافة

 FromFld [color= #339933;]:= ExcludeTrailingPathDelimiter[color= #009900;]([color= #990000;]Trim[color= #009900;](FromFld[color= #009900;])[color= #009900;])[color= #339933;];

ToFld [color= #339933;]:= ExcludeTrailingPathDelimiter[color= #009900;]([color= #990000;]Trim[color= #009900;](ToFld[color= #009900;])[color= #009900;])[color= #339933;];

في بداية وضيفة النسخ CopyFolder

لجذف \ من السلسة والا اعطان خطأ

ب) - اجراءات ووظائف تعمل على WMI

*-: اجراء يقوم بغلق كل برامج Office الوارد الاكسل ....الخ

procedure StopProcessOffice(iPCName:string);

الهدف : لانستطيع القيام بالغاء التثبيت عندما تكون احد البرامج مشغلة وهذا يحصل غالبا .

الفكرة :

*- استرجاع لائحة البروسس اي قائمة البرامج الموجودة في Task Manager باستعمال الوظيفة

Function WMIListePID(iPCName): TStringList

*- البحث عن برامج office اي

- 'NAME = WINWORD.EXE'

- 'NAME = MSACCESS.EXE'

- 'NAME = POWERPNT.EXE'

- 'NAME = EXCEL.EXE'

- 'NAME = POTOED.EXE

- 'NAME = OUTLOOK.EXE'

في هذه القائمة

*- وضعPID لكل برنامج مفتوح في vListPid هي متغيرة من نوع TStringList

*- انشاء حلقة تكرارية لغلق اليرامج الموجود رقمها اي PID في القائمة vListPid

 [color= #b1b100;]For j[color= #339933;]:=[color= #cc66cc;]0 to vListPid[color= #339933;].[color= #990000;]Count[color= #cc66cc;]-1 [color= #b1b100;]do

WMIStopProcess[color= #009900;](iPCName[color= #339933;],strtoint[color= #009900;](vListPid[color= #009900;][j[color= #009900;]][color= #009900;])[color= #009900;])[color= #339933;];

المطلوب

برمجة الوظائف

WMIStopProcess

WMIListePID

و الاجراء

StopProcessOffice

علما ان اسم الجهاز نمرره في الحين كمتغيرة وان شاء الله المرة القادمه اوضح كيف استرجاع اسماء الاجهزه المرتبطة بالشبكة عن طريق IP

اخي mohfa لو تكرمت مرة اخرى لوضع الرساءل بالغة العربية و الشرح ان امكن ذلك لافادة المبتديئن و الله يجازيك

اخي زكيري عبد العالي

إن شاء الله .

ماهي الخطوة التالية بعدما إنتهينا من اضافة الإجرائيات .

* المهم اخي زكيري عبد العالي لاتنسى الـ UNICODE !

* اخي زكيري عبد العالي

إن إستطعت إستبدال الرساءل بالغة العربية و الشرح ففعل ولك كامل الشكر

مازالت الخطوة الاولى راجع الموضوع هناك الجدبد لاتخف B)

ب) - اجراءات ووظائف تعمل على WMI

اقتباس

* المهم اخي زكيري عبد العالي لاتنسى الـ UNICODE !

بحول الله

السلام عليكم

لقد فتحت جبهة اخرى وحان الوقت لتثبتوا للجميع امكاناتكم مع الدلفي و مانستطيع فعله بالدلفي وكيف وكم من الوقت

/index.ph...169386&st=0

اخي عبد العالي

انا سوف اقوم بإنشاء ملف للاخطاءالمحتملة Errors.inc سوف يحوي كل الاخطاء المحتملة + رقم الخطاء + a Customized Exception Window

مارئك

هذه اول مشاركة لي في الموضوع

مع تغيير لمرفق الاخ mohfa

Project1.rar

بارك الله فيك اخي BLOODYSTORM

جاري التجريب

اخي BLOODYSTORM لقد نسيت إضافة ShareMem : في library Func;

اقتباس

{ Important note about DLL memory management: ShareMem must be the

first unit in your library's USES clause AND your project's (select

Project-View Source) USES clause if your DLL exports any procedures or

functions that pass strings as parameters or function results. This

applies to all strings passed to and from your DLL--even those that

are nested in records and classes. ShareMem is the interface unit to

the BORLNDMM.DLL shared memory manager, which must be deployed along

with your DLL. To avoid using BORLNDMM.DLL, pass string information

using PChar or ShortString parameters. }

مجهود رائع اخي BLOODYSTORM

المشروع معدل مع التحميل الديناميكي للـ Func.dll

ملاحظة اخي BLOODYSTORM : إن التحميل الستاتيكي للـ Dll فيه مشاكل مثال على ذلك حذف الـ Dll او نقلها الى مكان اخر غير دليل البرنامج .

زد على ذلك التحميل الستاتيكي للـ DLL يجبرك على ان تكون الـ DLL في دليل البرنامج غير ذلك سوف تملاء شاشتك بالاخطاء .

وكل هذه المشاكل يمكن تفاديها بالتحميل الديناميكي للـ DLL .

ملاحظة اخرى :

إن اريد تصدير وظيفة او إجرائية ترجع او تحوي قيمة من نوع String فلابدا من إضافة الوحدة ShareMem في اول الـ Uses للمشروع و الـ Dll وايضا لابدا من إرسال BORLNDMM.DLL مع المشروع .

وكل هذا يمكن تفاده بإستعمال الـ PChar او الـ PWideChar في مكان الـ String .

الاهم من كل ذلك انك قمت بمجهود جيد جدا .

* إظافة ملف MAFxpError.inc الذي يحوي الاخطاء الممكنة

// ليسمح لي اخي زكيري عبد العالي على هذا التعليق :

اضفت الملف MAFxpError.inc عن قصد وذلك ليعرف المبتدئ كيفية إضافة ملف يحوي الاخطاء الممكنة في برنامجه بطريقة جيدة

Project.zip

السلام عليكم

كل شئ الى حد الان جيد جدا ما عدى

procedure StopProcessOffice[color= #339933;];stdcall[color= #339933;];

const Processus [color= #339933;]: [color= #990000;]array [color= #009900;][[color= #cc66cc;]0[color= #339933;]..[color= #cc66cc;]4[color= #009900;]] of String [color= #339933;]=[color= #009900;]([color= #0000ff;]'WINWORD.EXE'[color= #339933;],[color= #0000ff;]'EXCEL.EXE'[color= #339933;],[color= #0000ff;]'MSACCESS.EXE'[color= #339933;],[color= #0000ff;]'POWERPNT.E
XE'[color= #339933;],[color= #0000ff;]'MSPUB.EXE'[color= #009900;]) [color= #339933;];

[color= #000000; font-weight: bold;]Var i [color= #339933;]: Integer[color= #339933;];

[color= #000000; font-weight: bold;]function WMIListePID[color= #009900;](ExeFileName[color= #339933;]: string[color= #009900;])[color= #339933;]: Integer[color= #339933;];

const

PROCESS_TERMINATE [color= #339933;]= $[color= #cc66cc;]0001[color= #339933;];

[color= #000000; font-weight: bold;]var

ContinueLoop[color= #339933;]: BOOL[color= #339933;];

FSnapshotHandle[color= #339933;]: THandle[color= #339933;];

FProcessEntry32[color= #339933;]: TProcessEntry32[color= #339933;];

begin

Result [color= #339933;]:= [color= #cc66cc;]0[color= #339933;];

FSnapshotHandle [color= #339933;]:= CreateToolhelp32Snapshot[color= #009900;](TH32CS_SNAPPROCESS[color= #339933;], [color= #cc66cc;]0[color= #009900;])[color= #339933;];

FProcessEntry32[color= #339933;].dwSize [color= #339933;]:= [color= #990000;]SizeOf[color= #009900;](FProcessEntry32[color= #009900;])[color= #339933;];

ContinueLoop [color= #339933;]:= Process32First[color= #009900;](FSnapshotHandle[color= #339933;], FProcessEntry32[color= #009900;])[color= #339933;];

 

[color= #b1b100;]while Integer[color= #009900;](ContinueLoop[color= #009900;]) [color= #339933;]<> [color= #cc66cc;]0 [color= #b1b100;]do

begin

[color= #b1b100;]if [color= #009900;]([color= #009900;](UpperCase[color= #009900;](ExtractFileName[color= #009900;](FProcessEntry32[color= #339933;].szExeFile[color= #009900;])[color= #009900;]) [color= #339933;]=

UpperCase[color= #009900;](ExeFileName[color= #009900;])[color= #009900;]) or [color= #009900;](UpperCase[color= #009900;](FProcessEntry32[color= #339933;].szExeFile[color= #009900;]) [color= #339933;]=

UpperCase[color= #009900;](ExeFileName[color= #009900;])[color= #009900;])[color= #009900;]) then

Result [color= #339933;]:= Integer[color= #009900;](TerminateProcess[color= #009900;](

OpenProcess[color= #009900;](PROCESS_TERMINATE[color= #339933;],

BOOL[color= #009900;]([color= #cc66cc;]0[color= #009900;])[color= #339933;],

FProcessEntry32[color= #339933;].th32ProcessID[color= #009900;])[color= #339933;],

[color= #cc66cc;]0[color= #009900;])[color= #009900;])[color= #339933;];

ContinueLoop [color= #339933;]:= Process32Next[color= #009900;](FSnapshotHandle[color= #339933;], FProcessEntry32[color= #009900;])[color= #339933;];

[color= #990000;]end[color= #339933;];

CloseHandle[color= #009900;](FSnapshotHandle[color= #009900;])[color= #339933;];

[color= #990000;]end[color= #339933;];

begin

[color= #b1b100;]For i [color= #339933;]:= [color= #cc66cc;]0 to [color= #cc66cc;]4 [color= #b1b100;]Do

WMIListePID[color= #009900;](Processus[color= #009900;][i[color= #009900;]][color= #009900;])[color= #339933;];

[color= #990000;]end[color= #339933;];

هذا الاجراء يهمل عل انها ء البروسس الموجود في الجهاز و نحن نريد ارسال تعليمه الى الجهاز المحدد بواسطة العنوان IP او اسم الجهاز Computer Name

لان الغاء التثبيت يتم عن بعد و الا بد من استخدام WMI اي تعليمات WQL

لاحظ الموضوع الاخر هناك مثال في المرقثات والمطلوب وظيفتين موجودتين في WMI.pas

شكرا

انتظر الرد بفارغ الصبر نحن نتقدم على منتدي السي شارب