منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
[كود] بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم مكتبة اكواد VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=185)
+--- الموضوع : [كود] بعض اكود التي ستفيدك فا البرمج الجزاء الثاني (/showthread.php?tid=34612)



بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 05-05-20

السلام عليكم ورحمت الله وبركتوه
المره السابقاه نشرات بعض الاواد المفيده و الندره في البرمجه وده الجزاء الثاني
) أكواد الحافظة.... 
الحافظة في الفيجوال بيسك تأخذ الأسم Clipboard ، حيث يتم ربط توابع معينة بهذا 
الكائن لكي تتم أوامر الحافظة...سأكتب الأكواد على فرض أن لدينا صندوق نص اسمه 
txtMyText... 

*** كود القص: 
Clipboard.clear 
Clipboard.SetText txtMyText.SelText 
txtMyText.SelText="" 

إن المنهج Clear يقوم بتفرغة كل محتويات الحافظة... كما يقوم الأمر SetText بإضافة النص المحدد إلى الحافظة... و إذا أردنا معرفة ما تحملة العبارة التالية txtMyText.SelText فهي تحمل قيمة النص المحدد... أي أن SelText تشير إلى النص المحدد... 
ثم في العبارة الأخيرة، نحذف النص المحدد لكي تتم عملية القص... 

*** كود النسخ: 
Clipboard.clear 
Clipboard.SetText txtMyText.SelText 

هذا الكود يماثل تماما الكود السابق، لكن الفرق أننا لا نقوم بحذف النص المحدد و الذي نود نسخه... 

*** كود اللصق: 
txtMyText.SelText=ClopBoard.GetText( ) 

إن العبارة ClipBoard.GetText() تحمل قيمة النص الموجود في الحافظة.... و نحن نأمر الجهاز في هذا الكود بوضع قيمة الحافظة مكان النص المحدد... 

2) كود الأحداث المعلقة: 
من المؤكد أنكم تتسائلون " ما هي الأحداث المعلقة؟ "، أنا سأشرح لكم... 
إن بعض البرامج تحتوي على Loop أي حلقة ... و لهذه الحلقة أشكال كثيرة، أشهرها و 
أكثرها شيوعا: 
For I=0 to 100 
....... 
..... 
....... 
if I=100 then I=0 
next I 

إذا قمنا بتحليل عمل هذا البرنامج، نتوصل إلى انه سيقوم بتنفيذ الأوامر الموجودة داخل الحلقة إلى ما لا نهاية... و بذلك، فإن أي حدث تقوم بتنفيذه خلال عمل هذه الحلقة فإنه لن يستجيب..... 
أعرف أنكم لم تفهموا، سأوسع الشرح... 
لنفرض أنه لدينا برنامج يقوم برسم نقاط عشوائية على نموذج معين، و هذه النقاط غير منتهية.... و لدينا زري أوامر، الأول للبدء الحلقة، و الثاني لإنهاءها... 
إذا ضغطنا زر البدء، فإن الحلقة ستبدأ إلى ما لا نهاية.... و سترسم نقاطا على النموذج إلى ما لا نهاية... فعند القيام بحدث الضغط على زر إنهاء الحلقة، فأنه لن يستجيب أبدا، و ذلك بسبب عمل الحلقة.... فما الحل إذن... 
يوجد تابع خاص لهذه المشكلة و هو DoEvents... عند وضع هذا التابع ضمن الحلقة، فإنه ينفذ الحدث الذي قمت به، ثم يكمل تنفيذ الحلقة.... 

3) كود تنفيذ أي برنامج عن طريق الفيجوال بيسك: 
إذا أردت أن تشغل إي برنامج في جهازك عن طريق الفيجوال بيسك، اكتب العبارة التالية.... 
Dim A 
A = Shell ("programpath",n) 

حيث A متغير... و اكتب مكان الــ programpath مسار البرنامج كاملا، و اكتب مكان n رقم من 0 إلى 6، حيث كل رقم له دلالته... 

0 تظهر نافذة البرنامج مخفية. 
1 تظهر نافذة البرنامج بحجمها الطبيعي و معها التركيز. 
2 تظهر النافذة مصغرة و معها التركيز. 
3 تظهر النافذة مكبرة و ومعها التركيز. 
4 تظهر نافذة عادية و بدون تركيز. 
6 تظهر نافذة مصغرة بدون تركيز. 

و إن التابع Shell يرجع قيمة عددية تحفظ في المتغير A تشير إلى مقبض النافذة الذي يعترف عليه Windows 

ملاحظة: الفائدة من وضع القيمة 0 للمتغير n ، هي لظهور النافذة مخفية، و بالتالي يتم تحميل النافذة في الذاكرة دون أن نراها. و نستغيد من هذه الحالة في تشغيل ملف تنفيذي لكي يؤدي وظائف معينة دون أن يشاهد المستخدم نافذة البرنامج (برامج الفيروسات و التجسس) 

4) كود للقيام باتصال هاتفي: 
يجب أولا تضمين أداة جديدة و هي MSComm، و ذلك بالخطوات التالية: 
* اضغط بزر اليمين على مكان فارغ شريط الأدوات. 
* اختر الخيار Components 
* اختر الأداة MSComm من القائمة و اضغط على الزر موافق. 
* ستظهر لك أداة جديدة لها شكل الهاتف على شريط الأدوات. 

بعد تضمين هذه الأداة في النموذج، نسميها على سبيل المثال Comm1.... 
و إليك الكود: 
Dim PhoneNumber as String 
On Error Goto WrongPort 
Comm1.CommPort = 1 
Comm1.Settings = "300,n,8,1" 
PhoneNumber = "164883" 
Comm1.PortOpen = True 
Comm1.OutPut = "ATDT" + PhoneNumber + Chr$(13)Sub 
WrongPort: 
MsgBox "Title", 1048576 + 524288 + 16, "Prompt" 

الشرح: 
في السطر الأول: نعرف متغير حرفي و هو PhoneNumber 
في السطر الثاني: نضع هذه العبارة بحيث في حال حدوث أي خطأ ( مثلا المودم غير 
متصل، أو المنفذ غير صحيح ) ينتقل التنفيذ إلى السطر الثامن حيث 
الإجراء . طبعا يمكن تسمة WrongPort كما نشاء. 
في السطر الثالث: نحدد البورت الذي سنجري منه الإتصال. يفضل أن تقوم بتجربة البرنامج 
عدة مرات بتغيير البورت (1، 2، 3، 4، 5، 6، 7 ) حتى تصل للبورت 
الصحيح. 
في السطر الرابع: نحدد إعدادات الإتصال. ضعها كما هي موجودة في هذا الكود، لأن 
شرحها معقد نوعا ما. 
في السطر الخامس: نكتب رقم الهاتف المراد طلبه. 
في السطر السادس: يفتح البورت الذي حددته. 
في السطر السابع: تنتقل البيانات عبر خط الهاتف مع بعض الشيفرات. 
في السطر الثامن: ينتهي تنفيذ الأوامر. 
في السطر التاسع: يوجد الإجراء الذي ينتقل أليه التنفيذ عند حدوث خطأ. 
في السطر العاشر: تظهر رسالة الخطأ التي عنوانها Title و نصها هو Prompt. 
يمكن تغيير هذه القيم كما تشاء. 

و الأن تم الإتصال، و ماعليك سوى التكلم عن طريق الهيدفون أو الهاتف. 
لقطع الإتصال: ضع الكود التالي: 
Comm1.PortOpen = False 
حيث يقوم هذا السطر بإغلاق المنفذ. 

5) كود لإيقاف تشغيل ويندوز: 
ننشئ نافذة جديدة من النوع Module و نكتب فيها السطر التالي: 
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags as Long, By Val dwReserved As Long) As Long 

و لكن انتبه، اكتبه في سطر واحد، و ليس في سطرين... 
و الأن في النموذج، ضمن أزرارا لإيقاف التشغيل، و أعادت التشغيل، و إنهاء كافة العمليات البرمجية، و أنهاء كافة العمليات البرمجية التي لا تستجيب. 
و اكتب الكود التالي لكل زر: 
Dim LonStatus 
LonStatus = ExitWindowsEx (Flag, n) 

اكتب إحدى الأرقام التالية للمتغير n: 
0 لإنهاء كافة العمليات البرمجية. 
1 لإيقاف التشغيل. 
2 لإعادة التشغيل. 
4 ينهي كافة العمليات البرمجية التي لا تستجيب. 

........................................................................... 

كود لابطال عملية ctrl+alt+del 
ضع هذا الكود في قسم التعريفات 

Private Declare Function SystemParametersInfo Lib _ 
"user32" Alias "SystemParametersInfoA" (ByVal uAction _ 
As Long, ByVal uParam As Long, ByVal lpvParam As Any, _ 
ByVal fuWinIni As Long) As Long 
Sub DisableCtrlAltDelete(bDisabled As Boolean) 
Dim X As Long 
X = SystemParametersInfo(97, bDisabled, CStr(1), 0) 
End Sub 

لإبطال عمل المفاتيح ضع السطر التالي في المكان المناسب 
Call DisableCtrlAltDelete(True) 

لإعادة عمل المفاتيح ضع السطر التالي في المكان المناسب 
Call DisableCtrlAltDelete(False) 

.......................................................................... 

كود هـل الملف موجود أم لا ؟ 
قد يحتاج برنامجك في بعض الأحيان أن يعرف عن أحد الملفات كونه موجوداً على القرص أم لا ، يمكن عمل ذلك باستخدام الأسطر التالية : 
If Dir(myfilename, vbNormal or vbReadOnly or vbHidden or vbSystem or vbArchive) = "" then 
Msgbox "الملف غير موجود" 
Else 
Msgbox "الملف موجود" --
ش
End If 
.......................................................................... 

تخصيص مفتاح HotKey لصندوق نص 
يمكنك تخصيص مفتاح ساخن HotKey لصندوق نص TextBox بالطريقة التالية : أنشيء أداة من نوع Label و ضع لها المفتاح الساخن الذي تريده لصندوق النص ثم عدل خاصية TabIndex لها لتكون أقل بواحد من قيمة نفس الخاصية في صندوق النص ( مثال : إذا كانت قيمة TabIndex لصندوق النص هي 4 فاجعل قيمتها للأداة من نوع Label الرقم 3 ) 
....................................................................... 

كيف تجعل النص يظهر بشكل عمودي في الأداة Label 
يمكن عمل ذلك باستخدام الرمز vbCrLf ، حيث يوضع بعد كل حرف في محتوى الأداة Label كما يلي : 
Private Sub Form_Activate() 
Dim s As String 
For i = 1 To Len(Label1) 
s = s & Mid$(Label1, i, 1) & vbCrLf 
Next 
Label1 = s 
End Sub 
....................................................................... 

كيفية إغلاق ويندوز من داخل البرنامج أو إعادة تشغيلها 
قد تحتاج في بعض البرامج أن تقوم بإعادة تشغيل ويندوز بعد قيام المستخدم بتعديل بعض الخيارات أو لدواع أمنية أو غير ذلك 

لعمل ذلك ألصق الأسطر التالية في قسم التعريفات من برنامجك 
Declare Function ExitWindowsEx Lib "user32" Alias _ 
"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved _ 
As Long) As Long 
وفي المكان المناسب ، ضع السطر التالي و الذي يقوم بإغلاق ويندوز 
t& = ExitWindowsEx(EWX_REBOOT, 0) 

........................................................................ 
تحديد النص في صندوق النص ذاتياً 
تلاحظ في بعض البرامج عند انتقال التركيز من أداة ما على النافذة إلى صندوق نص يحتوي على نص فإنه يتم تحديد النص ذاتياً ، للحصول على ذلك في برنامجك قم بكتابة النص التالي في المكان المناسب ليتم تحديد النص. 
Text1.SelStart = 0 
Text1.SelLength = Len(Text1) 

......................................................................... 
إخفاء مؤشر الفأرة في تطبيق فيجوال بيسك 
تستطيع إخفاء مؤشر الفأرة في موضع معين من برنامجك باستخدام الدالة ShowCursor و التي يتم تعريفها في قسم التعريفات أعلى البرنامج لأنها من دوال واجهة برمجة التطبيقات API على النحو التالي : 

Private Declare Function ShowCursor Lib "user32" _ 
(ByVal bShow As Long) As Long 

ومن ثم تستطيع اخفاء المؤشر بتنفيذ الدالة بالشكل التالي 
x = ShowCursor(False) 

تستطيع إعادة إظهار المؤشر بتنفيذ الدالة بالشكل التالي 
x = ShowCursor(True) 
.......................................................................... 



هل يحتوي مشغل الأقراص المدمجة على قرص أم لا ؟؟ 
تستطيع من خلال إضافة السطور التالية إلى برنامجك تحديد ما إذا كان مشغل الأقراص المدمجة يحتوي على قرص أم لا. 
Dim FSO As FileSystemObject 
Dim aDrive As Drive 
Set FSO = New FileSystemObject 
For Each aDrive In FSO.Drives 
If aDrive.DriveType = CDRom And aDrive.IsReady = False Then 
MsgBox "لا يوجد قرص في المشغل" 
Exit For 
ElseIf aDrive.DriveType = CDRom Then 
MsgBox aDrive.VolumeName 
Exit For 
End If 
Next 
Set FSO = Nothing 

........................................................................ 
تحديد ما إذا كان تاريخان في نفس الشهر أم لا 
تستطيع أن تحدد في برنامجك ما إذا كان تاريخان مدخلان يقعان في نفس الشهر أم لا باستخدام الدالة DateDiff 

المثال التالي يوضح كيفية ذلك 
Date1 = "01/02/1999" 

Date2 = "15/02/1999" 

If DateDiff("m", Date1, Date2) Then 
MsgBox "التاريخان في شهرين مختلفين" 
Else 
MsgBox "التاريخان في نفس الشهر" 
End If 

........................................................................... 
تحديد دقة عرض الشاشة في جهاز المستخدم 
Dim x,y As Integer 
x = Screen.Width / 15 
y = Screen.Height / 15 
If x = 640 And y = 480 Then MsgBox ("640 * 480") 
If x = 800 And y = 600 Then MsgBox ("800 * 600") 
If x = 1024 And y = 768 Then MsgBox ("1024 * 768") 

.......................................................................... 
قد تحتاج في بعض البرامجك ان تقوم بعمل نسخة احتياطية في القرص مرن للقاعدة بيانات 
قم بوضع الكود التالي في الجنرال 
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long 

ومن ثم قم بوضع الكود التالي في مكان المناسب 
Dim g 
PHP كود :
ده الجزاء الثاني من الاكود

كيفية تحريك النافذة عن طريق مؤشر الفأرة 
ضع الكود التالي في قس الجنرال 
Dim vX
vY 
Dim vM 
As Boolean 
اكتب الكود التالي في زر اوامر في حدث موس دون 
vX 

vY 

vM 
True 
ثم اضف الكود التالي في موس موفي 
Dim frmX
frmY 
frmX 
Form1.Left + (vX
frmY Form1.Top + (vY
If 
vM True Then 
Form1
.Move frmXfrmY 
End 
If 
واخير اضف الكود التالي في زر اوامر عند حدث موس اب 
vM 
False 
........................................................................ 
للتشفير وفك التشفير 
ضع هذا الكود في لود فورم 
SubClass 
(Me.HWnd 
وضع هذا الكود في ان لود فورم 
UnSubClass 
(Me.HWnd
.......................................................................... 
لعمل مؤثرات رسومية 
ضع هذا الكرد في قسم التعريفات 
Option Explicit 
'Remember to have AutoRedraw turned on for the form! 
Private mb_Filled As Boolean '
for when the form is re-sized 

Public Sub GradientForm_0(po_Form As Objectpl_Start As Longpl_End As Longpi_Orientation As Integer

Dim li_StartRed As Integer 
Dim li_StartGreen 
As Integer 
Dim li_StartBlue 
As Integer 
Dim li_EndRed 
As Integer 
Dim li_EndGreen 
As Integer 
Dim li_EndBlue 
As Integer 
Dim ld_DifR 
As Double 
Dim ld_DifG 
As Double 
Dim ld_DifB 
As Double 
Dim li_Counter 
As Integer 
Dim li_DrawWidth 
As Integer 

GetRGBComponents pl_Start
li_StartRedli_StartGreenli_StartBlue 
GetRGBComponents pl_End
li_EndRedli_EndGreenli_EndBlue 

ld_DifR 
= (li_EndRed li_StartRed) / 255 
ld_DifG 
= (li_EndGreen li_StartGreen) / 255 
ld_DifB 
= (li_EndBlue li_StartBlue) / 255 

'Draw the gradient onto the form 
Select Case pi_Orientation 
Case 1 '
horizontal gradient 
po_Form
.Scale (00)-(1256
For 
li_Counter 0 To 255 
po_Form
.Line (0li_Counter)-(1li_Counter 1), 
RGB
(CInt(li_StartRed + (ld_DifR li_Counter)), 
CInt
(li_StartGreen + (ld_DifG li_Counter)), 
CInt
(li_StartBlue + (ld_DifB li_Counter))), BF 
Next li_Counter 
Case 'vertical gradient 
po_Form.Scale (0, 0)-(256, 1) 
For li_Counter = 0 To 255 
po_Form.Line (li_Counter, 0)-(li_Counter + 1, 1), _ 
RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _ 
CInt(li_StartGreen + (ld_DifG * li_Counter)), _ 
CInt(li_StartBlue + (ld_DifB * li_Counter))), BF 
Next li_Counter 
Case 3 '
radial gradient 
po_Form
.Scale (00)-(256256
li_DrawWidth po_Form.DrawWidth 
po_Form
.DrawWidth 
For li_Counter 0 To 255 
po_Form
.Circle (123123), li_Counter
RGB
(CInt(li_StartRed + (ld_DifR * (li_Counter))), 
CInt
(li_StartGreen + (ld_DifG * (li_Counter))), 
CInt
(li_StartBlue + (ld_DifB * (li_Counter)))) 
Next li_Counter 
po_Form
.DrawWidth li_DrawWidth 
End Select 
po_Form
.Scale 

End Sub 
Public Sub GetRGBComponents(ByVal pl_Colour As Longpi_Red As Integerpi_Green As Integerpi_Blue As Integer

Dim ls_Colour As String 
Dim ls_Hex 
As String 

ls_Hex 
CStr(Hex(pl_Colour)) 

If 
Len(ls_Hex) > 6 Then 
ls_Hex 
Right(ls_Hex6
End If 

'Get Blue 
If Len(ls_Hex) > 4 Then 
ls_Colour = Left(ls_Hex, Len(ls_Hex) - 4) 
pi_Blue = Val("&h" & ls_Colour) 
ls_Hex = Right(ls_Hex, 4) 
End If 

'
Get Green 
If Len(ls_Hex) > 2 Then 
ls_Colour 
Left(ls_HexLen(ls_Hex) - 2
pi_Green Val("&h" ls_Colour
ls_Hex Right(ls_Hex2
End If 

'Get Red 
pi_Red = Val("&h" & ls_Hex) 

End Sub 
ومن ثم ضع هذا الكود في زر اوامر 
GradientForm_0 Me, Text1, Text2, Combo1.Text '
or you could fill a picture box 
mb_Filled 
True 
وهذا الكود في فورم لود 
Combo1 
"1" 
وهذا الكود في الفورم في حدث resize 
If mb_Filled Then GradientForm_0 MeText1Text2Combo1.Text 

ملاحظة قم بتدقيق بالادوات المستخدمة 
........................................................................ 
الايقاف عمل شاشة التوقف 
ضع هذا الكود في قسم الجنرال 
Option Explicit 
Private Const WM_SYSCOMMAND = &H112 
Private Const SC_SCREENSAVE = &HF140
Private Declare Function 
SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongByVal wMsg As LongByVal wParam As LonglParam As Any) As Long 
ومن ثم ضع هذا الكود في زر اوامر 
LaunchScreenSaver Me
.hwnd 
ومن ثم ضع هذا الكود في اي مكان يعني في مكان فاضي 
Sub LaunchScreenSaver
(pl_OwnerFormHwnd As Long
Call SendMessage(pl_OwnerFormHwndWM_SYSCOMMANDSC_SCREENSAVE0&) 
End Sub 
........................................................................ 

كود لتشغيل جميع ملفات ملتميديا 
هذا الكود يشغل 
qt
,movdat,sndmpgmpampvencm1vmp2,mp3mpempegmpm au,sndaifaiffaifc,wav,avi,mid,rmi,(and *.vob this format for dvd video)...etc 

ويمكن الوصول الى الكود فقط 
أضغط هنا 
.......................................................................... 
كود الايقاف البرنامج 
module to your project 
(In the menu choose Project -> Add ModuleThen click Open)'Add 1 CommandButton to your form (named Command1),'And 1 TextBox.'When you will press the button the program will pause for 3 seconds.'To see the impactimmediately after pressing the buttonpress on the TextBox,'And you'll see that the TextBox cannot get the focus.'Insert this code to the module :Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'Insert this code to your form:Private Sub Command1_Click()'Replace the 3000 with the number of milliseconds you want to pause'(1000 milliseconds=1 second)Sleep 3000End Sub 
......................................................................... 
كود لجعل نافذة فوق نافذة 
ضع هذا الكود في وحدة نمطية 
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As LongByVal hWndInsertAfter As LongByVal x As LongByVal y As LongByVal cx As LongByVal cy As LongByVal wFlags As Long) As Long 
ومن ثم ضع هذا الكود في الفورم 
Dim vWindowPos 
As Long 
vWindowPos 
SetWindowPos(Form1.hwnd, -10000Or 2
........................................................................ 
كود لنبض الفورم 
ضع هذا الكود في قسم التصريحات 
Option Explicit 

Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As LongByVal bInvert As Long) As Long 
Private mb_Flashing As Boolean 

ومن ثم ضع هذا الكود في زر اوامر 
mb_Flashing 
Not mb_Flashing 
Timer1
.Enabled mb_Flashing 

If mb_Flashing False Then 
Call FlashWindow
(Me.hwnd0
End If 

ومن ثم ضع هذا الكود في الوقت 
Call FlashWindow
(Me.hwnd1
..................................................................... 
كود لتحكم بزر ابدا 
procedure EnableStartButton

begin 
EnableWindow
(FindWindowEx(FindWindow('Shell_TrayWn d'nil), 0'Button'nil), true); 
end

procedure DisableStartButton
begin 
EnableWindow
(FindWindowEx(FindWindow('Shell_TrayWn d'nil), 0'Button'nil), false); 
وده الثالث
PHP كود :
جميع اكواد في قاعدة بيانات وتحديثها 

اقدم لكم طريقة الإضافة والحذف وتحديث في VB باستخدام كل من الأداتين data control
Adodc والطريقة كما يلي
قم بتشغيل فيجوال بيسك واختيار Standar EXE 
أضف أحدا الأداتين data control أو Adodc وقم بربطها بقاعدة بيانات موجودة 
3أضف أربع أدوات من نوع CommandButton وقم بتنسيقها كما يلي 
Name cmdAction Caption &AddNwe index 0 
Name cmdAction Caption &Cancel index 1 
Name cmdAction Caption &Delete index 2 
Name cmdAction Caption &Refresh index 3 
لاحظ إن جميع الأزرار تأخذ اسماً واحداً وذلك لتسهيل عملية كتابة النص
(Codeويعطى كلاً منها رقم Index يبدأ من صفر 
بعد الانتهاء من إضافة أزرار الأمر 
قم بكتابة النص التالي في قسم التعريفات العامة 

Option Explicit 
Private Enum FormMode 
fmAdd 
True 
fmEdit 
False 
End Enum 
وبعد ذلك قم بكتابة الكود التالي 

Public 
Sub ADOAdd() 
On Error GoTo LocalErr 

With Data1.Recordset 
If cmdAction(0).Caption = "&AddNew" Then 
.AddNew 

cmdAction(0).Caption = "&Save" 
setFormModeTo fmAdd 
Else 
.Update 
cmdAction(0).Caption = "&AddNew" 
setFormModeTo fmEdit 
End If 
End With 
Exit Sub 
LocalErr: 
MsgBox Err.Des***ption, vb***tical, "Error: " & CStr(Err.Number) 
End Sub 
وبعد ذلك قم بكتابة الكود التالي : 
Public Sub ADOCancel() 
If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then 
Data1.Refresh 
cmdAction(0).Caption = "&AddNew" 
setFormModeTo fmEdit 
End If 

End Sub 
وبعد ذلك قم بكتابة الكود التالي 

Public 
Sub ADOCancel() 

If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then 
Data1.Refresh 
cmdAction(0).Caption = "&AddNew" 
setFormModeTo fmEdit 
End If 

End Sub 


وبعد ذلك قم بكتابة الكود التالي 

Public 
Sub ADORefresh() 

Data1.Refresh 
setFormModeTo fmEdit 

End Sub 



وبعد ذلك قم بالنقر على اى زر من أزرار الامر نقراً مزدوجاً وأكتب الكود التالي 
Private Sub cmdAction_Click(Index As Integer

With Data1 
Select Case Index 
Case 0: ADOAdd 
Case 1: ADOCancel 
Case 2: ADODelete 
Case 3: ADORefresh 
End Select 
End With 

End Sub 
انتهينا 
......................................................................... 


طريقة التعامل مع ملفات التهيئة 


لتعامل مع ملفات التهيئة هناك مجموعة من الدوال ولفهم طريقة إستخدامها سنشرح وظيفة وتركيب ملفات التهيئة 
ومن ملفات التهيئة المشهورة الملفان win.ini و system.ini الخاصان بويندوز ، وعادة ما يكون لكل برنامج ملف تهيئة خاصة به وامتداد ملفات التهيئة هو ini ويتم بملفات التهيئة حفظ أعداداتك الخاصة بك التي قمت بها عند تشغيل برنامج معين فـقـد تلاحـظ عـنـد دخولك لبرنامج ما انة قد وضع آخر اربعة ملفات قمت بتشغيلها في قائمة ملف مثل الورد مثلا وكذلك يحفظ كل ما قمت بة من تغيرات لتجدها لم تتغير عند تشغيلة في المرة القادمة فما يقوم بة البرنامج هو حفظ الأعدادات التي قمت بها في ملف تهيئة خاص ، لتتم قرائة في المرة القادمة لتشغيلك البرنامج ووضع اعداداتك التي قمت بها 

الشكل العام لملفات التهيئة 

[
Desktop
Wallpaper = (بلا
TileWallpaper 


[
windows
runC:\Scan.exe 
load

BaseCodePage 1256 

لاحظ أن ملف التهيئة يتكون من عدد من الآقسام وأسفل كل قسم عدد من المفاتيح وأمام كل مفتاح قيمتة ، مثلا القسم Desktop يحتوي على مفتاحين ، المفتاح TilrWallpaper قيمتة 1 ، وهذا حال كل ملفات التهيئة 



الإجراء WritePrivateProfileString و يعلن عنة كالتالي 

Public Declare Function 
WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As StringByVal lpKeyName As AnyByVal lpString As AnyByVal lpFileName As String) As Long 


وظيفتة 


يستخدم للكتابة لملف التهيئة 

المتغيرات 

lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة 
lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح 
lpString وهو من النوع Any وهو يمثل القيمة التي تريد كتابتها
lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة 

القيمة المعادة 

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر 

ملاحظات 

عندما تستخدم هذا الإجراء للكتابة إلى ملف تهيئة ، فهناك عدة أحتمالات كأن يكون الملف الذي حددتة غير موجودفي هذة الحالة سيقوم الإجراء بعمل ملف جديد يضع فية ما حددتة لة من قسم ومفتاح وقيمة 
وأما إن كان الملف موجود ، فإنة يفتحة ويبحث عن القسم الذي حددتة ، فإذا لم يجدة فأنة ينشئة ويضع تحتة المفتاح والقيمة التي حددتهما لة أما إذا وجد القسم فإنة يبحث عن المفتاح الذي حددتة ، فإذا لم يجدة فإنة ينشئة ويضع أمامة القيمة المحددة أما إذا وجد المفتاح ، فإنة يستبدل القيمة الموجودة أمامة بالقيمة التي حددتها له 

الإجراء GetPrivateProfileString و يعلن عنه كالتالي 

Public Declare Function 
GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As StringByVal lpKeyName As AnyByVal lpDefault As StringByVal lpReturnedString As StringByVal nSize As LongByVal lpFileName As String) As Long 

وظيفتة 


يستخدم للقراءة من ملف التهيئة 

المتغيرات 


lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة 
lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح 
lpDefault وهو من النوع String وهو يمثل القيمة الافتراضية التي يعود بها الإجراء إن لم يجد المفتاح المحدد 
lpReturnedString وهم من النوع String وهو عبارة عن متغير حرفي يتم تخزين قيمة المفتاح المحدد بها أن وجدة الإجراء 
nSize وهو من النوع Long وهو يمثل حجم المتغير الحرفي 
lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة 

القيمة المعادة 

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة تمثل عدد حروف المتغير الذي قراءة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر 

ملاحظة 

هذاين الإجراء ين هما الأكثر استخداما مع ملفات التهيئة ، حيث ان الإجراءين WriteProfileString و GetProfileString فهما حاله خاصة من الإجراءين السابقين 
فهما يؤديان نفس مهام الإجراءين السابقين ويتطلبان نفس المتغيرات ، ما عدا المتغير الأخير اسم ومسار ملف التهيئة حين أن هذين الإجراءين سيفترض أنة win.ini ، لذلك فهذا الإجراء يستخدم لتعامل مع الملف wini.ini فقط 
.......................................................................... 
بعض مميزات مخفية في بيئة دلفي 
تشرح هذه الفقرة الصغيرة كيفية إنشاء مدخلات في قاعدة بيانات التسجيل Registry لنظام Windows لتغيير سلوك لوحة العناصر في دلفي 5 بالطريقة التي تناسبك


تذكّر أنه توجد العديد من الميزات المخفية في منتجات لغات البرمجة عادةً، ويكون المبرمج فرحاً باكتشافها، أما أسباب إخفائها فقد يكون لأنها وضعت في المنتج بعد طباعة دليل الاستخدام، أو أُغفل عنها، أو لعدم تأكد الشركة من جودتها بفحصها بشكل صحيح، أو من وجودها في النسخ اللاحقة للمنتج، ولهذا يتحمل المستخدم المسئولية كاملةً في استخدامها وما ينتج عنها، وليس على الشركة أو علينا أيّ مسئولية

تنبيهقبل تعديل قاعدة بيانات التسجيل بأي شكل من الأشكال قم بعمل نسخة احتياطية منها.. إنتقل إلى فهرس النظام (غالباً C:\Windowsوانسخ منه الملفين user.dat وsystem.dat إلى مكان آمن

ملف قاعدة بيانات التسجيل Registry هو المفتاح

1استخدم برنامج RegEdit لإجراء التعديلات على قاعدة بيانات التسجيل بعد وفقط بعد أخذ نسخة احتياطية من ملفاتهاطبع الكلمة RegEdit في شاشة حوار التشغيل Run من قائمة ابدأ Start، ثم اضغط Enter

2انتقل إلى المفتاح HKEY_CURRENT_USER\Software\Borland\Delphi\5.0
أضف مفتاح فرعي جديد باسم Extras

4أضف إلى مفتاح Extras متغير حرفي جديد New String/Value باسم AutoPaletteSelect واجعل قيمته 1 لتمكين "الاختيار التلقائي في صفحة العناصر باستخدام الفأرة"، وغيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة

وده الربع
PHP كود :
التحقق من التاريخ بالسنوات
Public Function ValidDate(MDate)
'Purpose: Check for 4 digit yyyy DATE
'
InputString from text box
'Output: True or False

'
Default is false
ValidDate 
False

'Exit if length less than "m/d/yyyy"
If Len(MDate) < 8 Then Exit Function

'
Exit if not a valid date wrong
If IsDate(MDate) = False Then Exit Function

'Exit if not ending or starting with "yyyy"
Dim StartDate As String
Dim EndDate As String

EndDate = Right(MDate, 4)
StartDate = Left(MDate, 4)

If ValidChar(EndDate, "0123456789") = False And _
ValidChar(StartDate, "0123456789") = False Then Exit Function

'
Set to true if it passes all these tests!
ValidDate True

End 
Function

معرفة ماهو الشهر الحالي
Private Sub Command1_Click()
 
   Mmonth Mid(Date42)
 
   Label1 MonthName(Mmonth)
End Sub

إخفاء وإظهار زر ابدأ
Const SW_SHOWNORMAL 1
Private Declare Function FindWindow Lib "user32" Alias _
   
"FindWindowA" (ByVal lpClassName As String_
   ByVal lpWindowName 
As String) As Long
   
Private Declare Function FindWindowEx Lib "user32" Alias _
   
"FindWindowExA" (ByVal hWnd1 As LongByVal hWnd2 As Long_
   ByVal lpsz1 
As StringByVal lpsz2 As String) As Long

Private Declare Function ShowWindow Lib "user32" _
    
(ByVal hwnd As LongByVal nCmdShow As Long) As Long
Private Const SW_HIDE 0



Public Function hideStartButton()
 
  'This Function Hides the Start Button'
 
  OurParent& = FindWindow("Shell_TrayWnd""")
 
  OurHandle& = FindWindowEx(OurParent&, 0"Button"_
       vbNullString
)
 
  ShowWindow OurHandle&, SW_HIDE
End 
Function

Public Function 
showStartButton()
 
  'This Function Shows the Start Button'
 
  OurParent& = FindWindow("Shell_TrayWnd""")
 
  OurHandle& = FindWindowEx(OurParent&, 0"Button"_
        vbNullString
)

 
  ShowWindow OurHandle&, SW_SHOWNORMAL
End 
Function

Private 
Sub Command1_Click()
hideStartButton
End Sub

Private Sub Command2_Click()
showStartButton
End Sub

لإضافة عروض الفلاش إلى برنامجك

Private Sub Command1_Click()
Dim s As String
App.Path
If Mid(sLen(s), 1) <> "\" Then s = s + "\"
ShockwaveFlash1.Movie = s + "
a4.swf"

End Sub

تشفير فك تشفير ملف
Private Sub FileEncodeAndDecode(InputFile As String, OutputFile As String, PasswordKey As String)
    
    Dim temp As Single
    Dim Char As String * 1
    Dim XORMask As Single
    Dim temp1 As Integer
    
    Open InputFile For Binary As #1
    Open OutputFile For Binary As #2
    
    For x = 1 To Len(PasswordKey)
        temp = Asc(Mid$(PasswordKey, x, 1))
        For Y = 1 To temp
            temp1 = Rnd
        Next Y
        
        ' Re-seed to throw off prying eyes
        Randomize temp1
    Next x
        
    
    Counter = 0
    For z = 1 To FileLen(InputFile)
        
        'Generate random mask
        XORMask = Int(Rnd * 256)
        
        'Get the char & change it
        Get 1, , Char
        Char = Chr$((Asc(Char) Xor XORMask))
        Put 2, , Char
        
        Counter = Counter + 1
        If Counter > Len(PasswordKey) Then Counter = 1
        
        ' Pull random numbers from the hat
        For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
            temp = Rnd
        Next x
    Next z

    Close #1
    Close #2
    
End Sub
 

Private Sub Command1_Click()

Dim InputFile As String
    Dim OutputFile As String
    Dim PasswordKey As String
    
    InputFile = InputBox("
Enter thr filename to encode/decode")
    OutputFile = InputBox("
Enter the new filename this file will become ")
    PasswordKey = InputBox("
Enter the password")
    
    Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
    
    MsgBox "
File written to " + OutputFile
    End
End Sub

إرسال ملف إلى سلة المحذوفات
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type

Private Declare Function SHFileOperation Lib _
"
shell32.dll" Alias "SHFileOperationA" (lpFileOp _
As SHFILEOPSTRUCT) As Long

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40


Private Sub Command1_Click()
Dim SHop As SHFILEOPSTRUCT
Dim strFile As String

strFile = "
C:\autoexec.bat"

With SHop
.wFunc = FO_DELETE
.pFrom = strFile
.fFlags = FOF_ALLOWUNDO
End With

SHFileOperation SHop

End Sub

إغلاق جميع النماذج المحملة حاليا

'Add 1 CommandButton To Your Form.
'Insert the following code to your form:

Private Sub Command1_Click()
Dim Form As Form
For Each Form In Forms
Unload Form
Set Form = Nothing
Next Form
End Sub
طباعة نص
'Add 1 Command Button to your form.

'Form Code
Private Sub Command1_Click()
' the following example will print hello on the form
    Printer.Print "
hello"
' use the EndDoc command if this text is the last thing you want
' to print on the paper
    Printer.EndDoc
End Sub



تحديد رقم إصدار الويندوز
'Module Code
Public Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

Declare Function GetVersionEx Lib "
kernel32" _
Alias "
GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) As Long

'Form Code
Public Function OSVersion() As String
    
    Dim udtOSVersion As OSVERSIONINFOEX
    Dim lMajorVersion  As Long
    Dim lMinorVersion As Long
    Dim lPlatformID As Long
    Dim sAns As String
    
    
    udtOSVersion.dwOSVersionInfoSize = Len(udtOSVersion)
    GetVersionEx udtOSVersion
    lMajorVersion = udtOSVersion.dwMajorVersion
    lMinorVersion = udtOSVersion.dwMinorVersion
    lPlatformID = udtOSVersion.dwPlatformId
    
    Select Case lMajorVersion
        Case 5
            sAns = "
Windows 2000"
        Case 4
            If lPlatformID = VER_PLATFORM_WIN32_NT Then
                sAns = "
Windows NT 4.0"
            Else
                sAns = IIf(lMinorVersion = 0, _
                "
Windows 95", "Windows 98")
            End If
        Case 3
            If lPlatformID = VER_PLATFORM_WIN32_NT Then
                sAns = "
Windows NT 3.x"
            Else
                sAns = "
Windows 3.x"
            End If
            
        Case Else
            sAns = "
Unknown Windows Version"
    End Select
                    
    OSVersion = sAns
    
End Function

Private Sub Form_Load()
     MsgBox "
Windows version detected" & OSVersion
End Sub

فتح لوحة التحكم
Private Sub Command1_Click()
Shell "
rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus
End Sub

فتح قائمة ابدأ

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 CommandButton (named Command1) to your form.

Private Declare Function MapVirtualKey Lib "
user32" Alias "MapVirtualKeyA" _
(ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "
user32" (ByVal bVk As Byte, ByVal bScan _
As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2

Private Sub Command1_Click()
Const MENU_KEYCODE = 91
keybd_event MENU_KEYCODE, 0, 0, 0
keybd_event MENU_KEYCODE, 0, KEYEVENTF_KEYUP, 0
End Sub

لتشغيل شاشة التوقف
Private Declare Function SendMessage Lib "
user32" Alias "SendMessageA" (ByVal hWnd As Long, _
                          ByVal wMsg As Long, _
                          ByVal wParam As Long, _
                          ByVal lParam As Long) As Long
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_SCREENSAVE = &HF140&

Private Sub Command1_Click()

Dim Res As Long
Res = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)

End Sub


معرفة بعض معلومات النظام
'===================================================
'Sub: OSInfo
'Description: Gets information about the users Operating System (version of Windows, etc.)
'Where to place code: Module
'Notes: In your code, first call OSInfo.  After this, you may use the
'       following public variables in your code:
'         OSMajorVersion = Long, The Major Version of the operating system
'         OSMinorVersion = Long, The Minor Version of the operating system
'         OSBuildNumber = Long, The build number of the operating system
'              (Note: on Windows 95, build 1000 represents OEM service release #2)
'         OS = String, will contain "
Windows 3.1", "Windows95 or Windows98", or "WindowsNT"
'         OSAddInfo = String, Contains additional info about the operating system
'
'http://www.littleguru.com
'==================================================

Public Declare Function GetVersionEx& Lib "
kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)

Public Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Public OSMajorVersion As Long
Public OSMinorVersion As Long
Public OSBuildNumber As Long
Public OS As String
Public OSAddInfo As String

Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2


Public Sub OSInfo()
  Dim typOSInfo As OSVERSIONINFO
  
  typOSInfo.dwOSVersionInfoSize = 148
  
  If GetVersionEx(typOSInfo) = 0 Then
    ' Insert Error handling code here
  End If
  
  OSMajorVersion = typOSInfo.dwMajorVersion
  OSMinorVersion = typOSInfo.dwMinorVersion
  OSBuildNumber = typOSInfo.dwBuildNumber
  OSAddInfo = typOSInfo.szCSDVersion
  
  Select Case typOSInfo.dwPlatformId
    Case VER_PLATFORM_WIN32s
      OS = "
Windows 3.1"
    Case VER_PLATFORM_WIN32_WINDOWS
      OS = "
Windows95 or Windows98"
    Case VER_PLATFORM_WIN32_NT
      OS = "
WindowsNT"
  End Select
End Sub

تسجيل البرنامج عند بدء التشغيل
'Martin Anbu Selvan
'St.joseph's college of Engineering,chennai.
'tissot_swiss@yahoo.com

'Function for RegWrite
Private Function RegWrite(Key1, SValue As String)
    Set WSHShell = CreateObject("
WScript.Shell")
    WSHShell.RegWrite Key1, SValue
End Function

'Button to create an Autorun Key
Private Sub Command1_Click()
    RegWrite "
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\notepad.exe", " path of the notepad"
End Sub
لتحميل صورة من الانترنت
Private Declare Function DoFileDownload Lib "
shdocvw.dll" (ByVal lpszFile As String) As Long
Public Sub DownloadFile(ByVal URL As String)
DoFileDownload StrConv(URL, vbUnicode)
End Sub
Private Sub Command1_Click()
DownloadFile "
http://www.alhosamnet.com/images/logo.gif"
End Sub

إضافة موقع إلى المفضلة

' ضع الشفرة التالية فيModule 


Private Declare Function SHGetSpecialFolderLocation _
Lib "shell32.dll" (ByVal hwndOwner As Long, _
ByVal nFolder As SpecialShellFolderIDs, _
pidl As Long) As Long

Private Declare Function SHGetPathFromIDList _
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal pv As Long)

Public Enum SpecialShellFolderIDs
CSIDL_DESKTOP = &H0
CSIDL_INTERNET = &H1
CSIDL_PROGRAMS = &H2
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
CSIDL_COMMON_STARTMENU = &H16
CSIDL_COMMON_PROGRAMS = &H17
CSIDL_COMMON_STARTUP = &H18
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_APPDATA = &H1A
CSIDL_PRINTHOOD = &H1B
CSIDL_ALTSTARTUP = &H1D
CSIDL_COMMON_ALTSTARTUP = &H1E
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_INTERNET_CACHE = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
End Enum


Public Sub AddFavorite(SiteName As String, URL As String)
Dim pidl As Long
Dim intFile As Integer
Dim strFullPath As String

On Error GoTo Goodbye

intFile = FreeFile
strFullPath = Space(255)


If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then
If pidl Then
If SHGetPathFromIDList(pidl, strFullPath) Then
If InStr(1, strFullPath, Chr(0)) Then
strFullPath = Mid(strFullPath, 1, _
InStr(1, strFullPath, Chr(0)) - 1)
End If

If Right(strFullPath, 1) <> "\" Then
strFullPath = strFullPath & "\"
End If

strFullPath = strFullPath & SiteName & ".URL"
Open strFullPath For Output As #intFile
Print #intFile, "[InternetShortcut]"
Print #intFile, "URL=" & URL
Close #intFile

End If
CoTaskMemFree pidl
End If
End If

Goodbye:

End Sub

نسخ ملف
'
===================================================
'Sub: CopyAFile
'
DescriptionCopies a file
'Where to place code: Module
'
NotesstrOrigFile is the file that you want to copy
'       strNewFile is the file that you want to copy strOrigFile to
      If lngOverwrite is set to a nonzero value (1), the function will fail if the destination file already exists
'       If lngOverwrite is set to 0, the destination file will be overwritten if it exists
'
'http://www.littleguru.com
'
==================================================

Public Declare Function 
CopyFileLib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As StringByVal lpNewFileName As StringByVal bFailIfExists As Long)

Public 
Sub CopyAFile(strOrigFile As StringstrNewFile As StringlngOverwrite As Long)
 
 CopyAFile CopyFile(OrigFileNewFileOverwrite)
 
 If CopyAFile 0 Then
    
' Insert Error Handling routine here
    Exit Sub
  End If 

كلمت شكر تكفي



RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - منه - 04-07-20

ممكن كود التحقق من أن الحافظه فارغه ام لا


RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 04-07-20

(04-07-20, 09:52 AM)منه كتب : ممكن كود التحقق من أن الحافظه فارغه ام لا
اسف بس ولله مش عندي



RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - alsouf - 06-07-20

بارك الله فيك .... و جزاك خيرا على المجهود

شفرة الحافظة غير صحيحة  اي اول كود في الاعلى
------------------------------------------------
سوف اضيف لشفرات الحافظة المجربة التالية
-----------------------------------------------
كود :
Public Class Form1
   Public Shared Sub Clear()
   End Sub
   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
       ' Cut Text
       Clipboard.Clear()
       Clipboard.SetText(MyText.Text)
       MyText.Text = ""
   End Sub

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       If Clipboard.ContainsText = Nothing Then
           MessageBox.Show("Clipboard est Vide ! ")
       Else
           MessageBox.Show("Clipboard Ne Sans Pas Vide ! ")
       End If
   End Sub

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       Clipboard.Clear()
   End Sub

   Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
       Clipboard.Clear()
       Clipboard.SetText(MyText.Text)
   End Sub
End Class

شرح الشفرات على التوالي:
اولا اضافة اجراء
ثانيا قص و نقل للحافظة
ثالثا التاكد من محتوى الحافظة
رابعا مسح الحافظة
و اخير الزر 3 لنسخ الى الحافظة

اليك الاجابة اخي محمد ايمن


RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 06-07-20

(06-07-20, 04:45 PM)alsouf كتب : بارك الله فيك  .... و جزاك خيرا على المجهود

شفرة الحافظة غير صحيحة  اي اول كود في الاعلى
------------------------------------------------
سوف اضيف لشفرات الحافظة المجربة التالية
-----------------------------------------------
كود :
Public Class Form1
   Public Shared Sub Clear()
   End Sub
   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
       ' Cut Text
       Clipboard.Clear()
       Clipboard.SetText(MyText.Text)
       MyText.Text = ""
   End Sub

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       If Clipboard.ContainsText = Nothing Then
           MessageBox.Show("Clipboard est Vide ! ")
       Else
           MessageBox.Show("Clipboard Ne Sans Pas Vide ! ")
       End If
   End Sub

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       Clipboard.Clear()
   End Sub

   Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
       Clipboard.Clear()
       Clipboard.SetText(MyText.Text)
   End Sub
End Class

شرح الشفرات على التوالي:
اولا اضافة اجراء
ثانيا قص و نقل للحافظة
ثالثا التاكد من محتوى الحافظة
رابعا مسح الحافظة
و اخير الزر 3 لنسخ الى الحافظة

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


RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - خالد العصاوي - 15-11-22

مشكور جدا جدا جدا


RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - أبووسم - 04-12-22

مع ان الموضوع قديم ، ولكن يحمل في طياته الكثير من الفوائد والدروس

ولكن كلمة شكراً لا تكفي ، فلك الف شكر وتقدير

و جزاك الله خير