منتدى الدورات التأهيلية اسئلة دورة ادخال بيانات ومعالجة نصوص والاختبار الشامل


عدد مرات النقر : 33,042
عدد  مرات الظهور : 38,680,250

موضوع مغلق
 
LinkBack أدوات الموضوع انواع عرض الموضوع
قديم 22-03-2006, 05:12 AM   #1

الصورة الرمزية صمت الجمال

 رقم العضوية :  35
 تاريخ التسجيل :  06-09-2004
 المشاركات :  1,120
 العمر :  38
 عدد النقاط :  10
 قوة التقييم :  صمت الجمال is on a distinguished road
 اخر مواضيع » صمت الجمال
 تفاصيل مشاركات » صمت الجمال
 أوسمة و جوائز » صمت الجمال
 معلومات الاتصال بـ صمت الجمال

افتراضي أكواد vb للمحترف و الهاوي


اكواد فجول بيسك

كودات رائعة وجميلة

للأتصال بالأنترنت باستخدام الdailup connection


*كود برمجي*


--------------------------------------------------------------------------------



Option Explicit

Private Sub Command1_Click()
Dim X
Dim DialUpConnectName As String
'قم بتحديد اسم الاتصال الذي تود الاتصال به
DialUpConnectName = "Sts"
X = ************l("rundll32.exe rnaui.dll,RnaDial " & DialUpConnectName, 1)
DoEvents
'في حال اردت ارسال كلمة السر ايضا قم باضافتها في النص التالي قبل القوس الاول مباشرة
'"123(enter)"
SendKeys "{enter}", True
DoEvents
End Sub
كود خاص لمعرفة كلمة السر لملفات Access 97
*كود برمجي*


--------------------------------------------------------------------------------


Option Explicit
Private zChar As String
Dim n As Long, s1 As String * 1, s2 As String * 1
Dim lsClave As String
Dim mask As String


Private Sub Command1_Click()
' يجب ان تضيف عنصر commonDialog الى برنامجك واسمه هنا DD
DD.Filter = "Microsoft Access Data************|*.mdb"
DD.Defaul************ = "mdb"
DD.ShowOpen
zChar = DD.FileTitle
mask = Chr(78) & Chr(134) & Chr(251) & Chr(236) & _
Chr(55) & Chr(93) & Chr(68) & Chr(156) & _
Chr(250) & Chr(198) & Chr(94) & Chr(40) & Chr(230) & Chr(19)
Open zChar For Binary As #1
Seek #1, &H42
For n = 1 To 14
s1 = Mid(mask, n, 1)
s2 = Input(1, 1)
If (Asc(s1) Xor Asc(s2)) <> 0 Then
lsClave = lsClave & Chr(Asc(s1) Xor Asc(s2))
End If
Next
Close 1
MsgBox lsClave & "كلمة السر هــي"
End Sub



--------------------------------------------------------------------------------


معرفة الوقت الذي مضى على تشغيل الويندوز (الوقت هنا بالملي ثانية)
*كود برمجي*


--------------------------------------------------------------------------------


Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Command1_Click()
MsgBox Format(GetTickCount, "0")
End Sub


--------------------------------------------------------------------------------

كود لاضافة بيانات حقل معين في قاعدة البيانات الى عنصر list
*كود برمجي*
Private Sub Form_Activate()
Dim a As String
Do While Not Data1.Recordset.EOF = True
a = Data1.Recordset.Fields("name").Value
' هنا تمثل اسم الحقل في قاعدة البيانات name كلمة
List1.AddItem a
Data1.Recordset.MoveNext
Loop
End Sub


--------------------------------------------------------------------------------


كود يقوم بحماية برنامجك حيث يعمل عدد من المرات (تحددها بنفسك) ثم يتوقف نهائيا عن العمل ، وهو يشبه طريقة عمل الـ(register) في البرامج المشهورة
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Load()
retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 3 Then ' الرقم (3) يحدد عدد مرات التشغيل
MsgBox "انتهت مدة تشغيل البرنامج .. عليك بشراء النسخة الاصلية"
Unload FRM '
End If
End Sub


--------------------------------------------------------------------------------


يقوم بتحويل شكل التكست واليبل الى 3d
*كود برمجي*


--------------------------------------------------------------------------------


'Set form's AutoRedraw property toTrue
Sub PaintControl3D(frm As Form, Ctl As Control)
' This Sub draws lines around controls to make them 3d

' darkgrey, upper - horizontal
frm.Line (Ctl.Left, Ctl.Top - 15)-(Ctl.Left + _
Ctl.Width, Ctl.Top - 15), &H808080, BF
' darkgrey, left - vertical
frm.Line (Ctl.Left - 15, Ctl.Top)-(Ctl.Left - 15, _
Ctl.Top + Ctl.Height), &H808080, BF
' white, right - vertical
frm.Line (Ctl.Left + Ctl.Width, Ctl.Top)- _
(Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &HFFFFFF, BF
' white, lower - horizontal
frm.Line (Ctl.Left, Ctl.Top + Ctl.Height)- _
(Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &HFFFFFF, BF

End Sub

Sub PaintForm3D(frm As Form)
' This Sub draws lines around the Form to make it 3d

' white, upper - horizontal
frm.Line (0, 0)-(frm.ScaleWidth, 0), &HFFFFFF, BF
' white, left - vertical
frm.Line (0, 0)-(0, frm.ScaleHeight), &HFFFFFF, BF
' darkgrey, right - vertical
frm.Line (frm.ScaleWidth - 15, 0)-(frm.ScaleWidth - 15, _
frm.Height), &H808080, BF
' darkgrey, lower - horizontal
frm.Line (0, frm.ScaleHeight - 15)-(frm.ScaleWidth, _
frm.ScaleHeight - 15), &H808080, BF

End Sub

'DEMO USAGE
'Add 1 label and 1 ************box


Private Sub Form_Load()

Me.AutoRedraw = True
PaintForm3D Me
PaintControl3D Me, Label1 'Label1 is name of label
PaintControl3D Me, ************1 '************1 is name of ************box

End Sub
ملاحظة في البداية لبد من انشاء تكست وليبل


--------------------------------------------------------------------------------


كود الاظهار النص بشكل عمودي
*كود برمجي*


--------------------------------------------------------------------------------


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



--------------------------------------------------------------------------------


كود تستطيع من خلاله حذف اي ملف
*كود برمجي*


--------------------------------------------------------------------------------


قم بوضع هذا الكود في قسم جنرال
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
ومن ثم حدد سار الملف مثال
Private Sub Command1_Click()
dim x
x = DeleteFile("C:\WINDOWS\system\LZEXPAND.DLL")


--------------------------------------------------------------------------------


كود لاستدعاء ملف من نوع mid
*كود برمجي*


--------------------------------------------------------------------------------


قم بوضع اداة
mmcontrol1


m و
اجعل نامي
Private Sub Form_Load()
m.DeviceType = "sequencer"
m.FileName = ("e:\Holiday3.mid")
m.Command = "open"
m.Command = "play"
END SUB


--------------------------------------------------------------------------------


كود لتحميل فلاش من نوع SWF
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Load()
s.Movie = ("E:\Projects\Howl.swf")
End Sub


--------------------------------------------------------------------------------


عرض صندوق حوار Open With
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Command1_Click()
Dim x As Long
x = ************l("rundll32.exe ************l32.dll,OpenAs_RunDLL C:\vbzoom.log")
End Sub


هذا الكود لإضافة عروض الفلاش لبرنامجك
*كود برمجي*


--------------------------------------------------------------------------------


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

End Sub


--------------------------------------------------------------------------------


لإنهاء صلاحيات برنامجك التجريبي بعد30 يوماً فقط
*كود برمجي*


--------------------------------------------------------------------------------


Dim startdate As String
Dim differenceofdate
Dim TRACEDATE As String
Dim newdate
Dim chk

If GetSetting(App.Title, "Startup", "counter", "") = "" Then
SaveSetting App.Title, "Startup", "counter", 1
SaveSetting App.Title, "Startup", "Started", Format(Date, "mm dd yyyy")
SaveSetting App.Title, "Startup", "Last Used", Format(Date, "mm dd yyyy")
lblcnt.Caption = "1"

ElseIf GetSetting(App.Title, "Startup", "counter", "") = "31" Then

MsgBox "شكراً لستخدامك هذا البرنامج " & Chr(10) + Chr(1) & "الرجاء إيقاف عمل هذا البرنامج او سيتم فقدان كل المعلومات التي قمت بإدخالها ", vbCritical, "شكراً لك "

End

Else
TRACEDATE = GetSetting(App.Title, "Startup", "Last Used", "")
chk = DateDiff("d", CDate(TRACEDATE), Now)
If chk < 0 Then 'CHECK IF THE DATE WAS CHANGE which is lesser than the PREVIOUS DATE WHERE THE SYSTEM USED.

MsgBox "لم يتم العثور على تاريخ النظام لديك !! " & Chr(10) + Chr(13) & " الرجاء تغييرة الأن وإلا لن يكون بإمكانك إستخدام هذا البرنامج لاحقاً", vbCritical, "تاريخ مفقود"

End
Else
startdate = GetSetting(App.Title, "Startup", "Started", "")
differenceofdate = DateDiff("d", startdate, Now)
If differenceofdate <> 0 Then
lblcnt.Caption = differenceofdate + 1
SaveSetting App.Title, "Startup", "Last Used", Format(Now, "MM DD YYYY")
SaveSetting App.Title, "Startup", "counter", differenceofdate + 1
End If
If differenceofdate = 0 Then
lblcnt.Caption = GetSetting(App.Title, "Startup", "Counter", "")
End If
End If
End If
End Sub


--------------------------------------------------------------------------------
كود لنسخ خلفية سطح المكتب إلى نموذجك
*كود برمجي*


--------------------------------------------------------------------------------



Private Declare Function PaintDesktop Lib "user32" _
(ByVal hdc As Long) As Long

'انسخ هذ الكودالى حدث النقر في زر الامر
Private Sub Command1_Click()
PaintDesktop Form1.hdc
End Sub



تحيه حسب الوقت
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Load()


If Time <= "11:30 AM" Then
MsgBox ("Good Morning YourNameHere!")
End
End If


If Time > "11:30 AM" And Time < "5:00 PM" Then
MsgBox ("Good Afternoon YourNameHere!")
End
End If


If Time > "5:00 PM" Then
MsgBox ("Good Evening YourNameHere!")
End
End If


If Time >= "12:01 AM" Then
MsgBox ("Good Morning YourNameHere!")
End
End If
End Sub


يمكن الربط باستخدام وسائل متعددة وكثيرة سألخص منها :Data,ADO,RDO,DOA


عند اسخدام Data يمكن انزال الأداة مباشرة من شريط الادوات وضبط خاصيةdata source بالقاعدة التي يجب أن يم حويلها الى 97 ثم record source وهو اسم الجدول أو الاستعلام المطلوب ربطه ويجب ضبط خاصية recordtype وهو table ,dynaset,snapshot أي جداول أو نماذج وقارير أو للقراءة فقط(هناك خصائص لكل نوع)
أما أداة ADO فيم نزيلها بوضع الماوس على شريط الادوا والضغط بالايمن على components واختيار الاداة

ولضبط خصائصها بالايمن أيضا على الاداة وربطها مع القاعدة المطلوبة او ODBCومع الجدول او الاستعلام المطلوب كما يمكن (وهذا أفضل ) ربطهم عن طريق الكود بالطريقة التالية
1- DATA :
2- نكتب في الكود الخاص بالفتح :
Data1.Data************Name = App.Path & "\mydata************97.mdb"
Data1.RecordsetType = dbOpenTable
Data1.RecordSource = "tablename"

3- أما ADO:
4- فيتم ضبط خاصية useconnection string: باختيار القاعدة كالتالي
5- Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=H:\pharm\Hanan\Doctors\mydbc97.mdb

أو يمكن كتابة ذلك في الكود كما يلي

Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Data************ Password=; Data Source=" & App.Path & "\DB\\db1.mdb"
Set db = DBEngine.Workspaces(0).OpenData************(App.Path & "\DB\db1.mdb")

ولفتح القاعدة والبحث عن أي شيء sequential نكتب مايلي

Set RS = db.OpenRecordset("tablename", dbOpenTable) 'Table
Do While Not RS.EOF 'to end of table
If RS!feildname = myname Then
"Do any thing u want"
Exit Do
End If
RS.MoveNext
Loop

يكن فتح القاعدة بتنشيط اداة DOA ووضع الكود التالي في formload or activate مثلا هنا لا يشترط تحويل القاعدة ل97

Set objconn = New ADODB.Connection
objconn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source = " & App.Path & "\data************name.mdb"
objconn.Open

Set objcomm = New ADODB.Command
objcomm.ActiveConnection = objconn
objcomm.CommandType = adCmd************
objcomm.Command************ = "Select < field name> From <Table name>"
Set objrec = New ADODB.Recordset
Set objrec.Source = objcomm
objrec.Cursor************************ = adUseClient
objrec.Open
objcomm.Execute
Set Combo1.DataSource = objrec
Set Combo1.RowSource = objrec
Combo1.ListField = "<field name>"
Combo1.DataField = "<field name"


,والموضوع يطول شرحه وارجو الاستفادة كما واعذروني على الاسلوب في الكتابة

توقيع :




أنا رحاله صغير أحمل في جيبي بذور ( بذور محبه ) كلما التقيت بإنسان زرعة معه بذوري إن سقاها كبرت وأينعت وإن لم يسقها ماتت واندثرت
وما همني إن سقاها أو ماتت ما يهمني هو عندما أصعد قمت الجبل وأنظر خلفي وأرى بساتين المحبة أشعر حينها بالإنسانيه


صمت الجمال غير متواجد حالياً
رسالة لكل زوار منتديات العبير

عزيزي الزائر أتمنى انك استفدت من الموضوع و لكن من اجل منتدى ارقي و ارقي برجاء عدم نقل الموضوع و يمكنك التسجيل معنا و المشاركة معنا و النقاش في كافه المواضيع الجاده اذا رغبت في ذلك فانا لا ادعوك للتسجيل بل ادعوك للإبداع معنا . للتسجيل اضغظ هنا .

قديم 22-03-2006, 09:07 PM   #2
Has A Reputation Beyond Repute

الصورة الرمزية أحمد نسيب

 رقم العضوية :  220
 تاريخ التسجيل :  17-10-2005
 المشاركات :  4,029
 الجـنـس :  ذكر
 عدد النقاط :  50215
 قوة التقييم :  أحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud ofأحمد نسيب has much to be proud of
 اخر مواضيع » أحمد نسيب
 تفاصيل مشاركات » أحمد نسيب
 أوسمة و جوائز » أحمد نسيب
 معلومات الاتصال بـ أحمد نسيب

افتراضي


وديني اللي يقول عليك كلمة لأخليه ينتمنى أنهة يشوف الشمس مرة ثانية



ربي يخليك ويديمك تاج فوق راسي وراس الكل في المنتدى

توقيع :

سبحانك اللهم وبحمدَك

من يهتم بنفسه العليا يصبح رجلا عظيما، أما من يهتم بنفسه السفلي فيصبح رجل وضيعا.
منسيوس
فيلسوف صيني كونفوشيوسي قديم.

أحمد نسيب غير متواجد حالياً
قديم 22-03-2006, 09:11 PM   #3

الصورة الرمزية عبد الله الساهر

 رقم العضوية :  1
 تاريخ التسجيل :  22-07-2004
 المشاركات :  71,583
 الدولة :  ムレ3乃乇乇尺
 الجـنـس :  ذكر
 العمر :  38
 عدد النقاط :  243859
 قوة التقييم :  عبد الله الساهر تم تعطيل التقييم
 SMS :

حتى لو اجتهدت و قطعت فؤادك.. ووضعته للناس في طبق فضي ليرضوا عنك لن تفلح وربما لن تصل لمستوى يرضيك أنت عن نفسك فاجتهد ليكون الله وحده راضياً عنك وأغمض عينيك عن ما سواه

 اخر مواضيع » عبد الله الساهر
 تفاصيل مشاركات » عبد الله الساهر
 أوسمة و جوائز » عبد الله الساهر
 معلومات الاتصال بـ عبد الله الساهر

افتراضي


روووووووعه روووووووووعه


روووووووووووووعه


روووووووووووووووووووووووووعه



ربنا يجزاكي خير في قمة الجمال وانا جاري تطبيقها عندي


ربي لايحرمنا من تواصلك الرائع والمميز بحق

توقيع :





رحمك الله يا أنس
وجعل الفردوس دارك ومستقرك



عبد الله الساهر غير متواجد حالياً
قديم 23-03-2006, 07:21 AM   #4

الصورة الرمزية صمت الجمال

 رقم العضوية :  35
 تاريخ التسجيل :  06-09-2004
 المشاركات :  1,120
 العمر :  38
 عدد النقاط :  10
 قوة التقييم :  صمت الجمال is on a distinguished road
 اخر مواضيع » صمت الجمال
 تفاصيل مشاركات » صمت الجمال
 أوسمة و جوائز » صمت الجمال
 معلومات الاتصال بـ صمت الجمال

افتراضي


احمد نسيب


انت اميز مني وما انا إلا قطرة في بحر ابداعاتك



عبودي الاستاذ الرائع لي


شكرا لك

صمت الجمال غير متواجد حالياً
قديم 27-03-2006, 02:56 PM   #5

الصورة الرمزية أمـ جود ـ

 رقم العضوية :  4
 تاريخ التسجيل :  22-07-2004
 المشاركات :  6,182
 العمر :  36
 عدد النقاط :  32
 قوة التقييم :  أمـ جود ـ is on a distinguished road
 اخر مواضيع » أمـ جود ـ
 تفاصيل مشاركات » أمـ جود ـ
 أوسمة و جوائز » أمـ جود ـ
 معلومات الاتصال بـ أمـ جود ـ

افتراضي


تسلمي يالغلا

توقيع :



مٍَآعُآدُ يًرٍضَيًنٍيً وَفٍآ...و لآيًزٍعُلنٍيً جََفٍآ..
مٍَتِسِآويًهُـ َفٍيً خٍآطَرٍيً ..ظِلمٍَـ آلبُشُرٍ وآنٍصِآَفٍهُمٍَـ..
ولو تِوَقٍَِفٍ آلدُنٍيًآ عُلىٍ شُمٍَعُ آلغٌَرٍآمٍَـ آلليً طََفٍآ..
بُعُضَ آلشُمٍَوعُ..أنٍآ أتِعُمٍَدُ گسِرٍهُآ وآتِلآَفٍهُآ..

أمـ جود ـ غير متواجد حالياً
قديم 27-03-2006, 10:03 PM   #6

الصورة الرمزية صمت الجمال

 رقم العضوية :  35
 تاريخ التسجيل :  06-09-2004
 المشاركات :  1,120
 العمر :  38
 عدد النقاط :  10
 قوة التقييم :  صمت الجمال is on a distinguished road
 اخر مواضيع » صمت الجمال
 تفاصيل مشاركات » صمت الجمال
 أوسمة و جوائز » صمت الجمال
 معلومات الاتصال بـ صمت الجمال

افتراضي


الله يخليك ياغالية ويخليك الكل

صمت الجمال غير متواجد حالياً
موضوع مغلق

مواقع النشر (المفضلة)


أدوات الموضوع
انواع عرض الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML معطلة
Trackbacks are متاحة
Pingbacks are متاحة
Refbacks are متاحة



الساعة الآن 12:42 PM


Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Content Relevant URLs by vBSEO 3.6.0 TranZ By Almuhajir
Ads Organizer 3.0.3 by Analytics - Distance Education
جميع الحقوق محفوظة لـ : منتديات العبير
المحتوى المنشور فى موقع العبير لايعبر بالضرورة عن وجهة نظر الإدارة وإنما يعبر عن وجهة نظر كاتبها