ذخیره اطلاعات بدون استفاده از بانک

[30yamand]

با سلام خدمت دوستان برنامه نویس
دوستان چه جوری میتونیم اطلاعات در برنامه که نوشتیم رو ذخیره کنیم بدون اینکه از data base استفاده کنیم منظورم اینه که بدون استفاده از بانک

من چند روز پیش یه برنامه دیدم که فاکتور فروش بود اطلاعاتی که در فاکتور ذخیره می شد به هیچ بانکی متصل نبود اگه برنامه رو می بستی و دوباره اجراش میکردی هم اطلاعات ثبت شده قبلی وجود داشت

[fazelm]

با سلام خدمت دوستان برنامه نویس
دوستان چه جوری میتونیم اطلاعات در برنامه که نوشتیم رو ذخیره کنیم بدون اینکه از data base استفاده کنیم منظورم اینه که بدون استفاده از بانک

من چند روز پیش یه برنامه دیدم که فاکتور فروش بود اطلاعاتی که در فاکتور ذخیره می شد به هیچ بانکی متصل نبود اگه برنامه رو می بستی و دوباره اجراش میکردی هم اطلاعات ثبت شده قبلی وجود داشت

اطلاعت کم رو می تونی تو رجستری ذخیره کنی و اطلاعات بیشتر رو می تونی تو یه فایل

[yosefi_hossein]

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

[30yamand]

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

Public Sub mnusave_Click()
On Error GoTo Line1
SaveCurrentRecord
alltotal
SaveCurrentRecord
ShowCurrentRecord
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub

[fazelm]

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

Public Sub mnusave_Click()
On Error GoTo Line1
SaveCurrentRecord
alltotal
SaveCurrentRecord
ShowCurrentRecord
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


کل برنامه رو بزار یعنی سورسش رو

[vbcenter]

ینام یگانه برنامه نویس هستی

با عرض سلام خدمت دوست عزیزمان . راه های متعددی برای ذخیره کردن اطلاعات وجود دارد که فقط یکی از آنها بانک اطلاعاتی است . راه های دیگری از قبیل ذخیره در رجیستری نیز هست . اما یکی از ساده ترین راه ها کار با فایل و ذخیره اطلاعات در یک فایل است . در این روش شما می توانید اطلاعات متنی را در یک فایل با هر پسوندی که می خواهید بجز پسوند فایل های اجرایی و فایل های تصویری قرار دهید . مثلا اطلاعات داخل برنامه تان را در یک فایل با نام save و پسوند به فرض abc قرار دهید که شما در این روش قادر هستید از هر پسوندی استفاده نمایید و می توانید از اطلاعات درون این فایل ها به عنوان یک فایل متنی استفاده نمایید . برای ایجاد همین فایل برای ذخیره اطلاعات در یک درایو مثلا C ، باید از دستور Open استفاده نمایید . درست است این دستور برای باز کردن یک فایل است . اما با استفاده از پارامتر Output که در ادامه مشاهده می نمایید ، می توانید یک فایل با هر پسوندی را ایجاد نمایید :

open "C:\save.abc" for output as #1
print #1,vardata
close #1

همانطور که مشاهده می نمایید ما از دستور Open برای ایجاد فایل برای ذخیره اطلاعات با استفاده از پارامتر Output استفاده کرده ایم . 1# نیز بیانگر شماره فایلی است که در محیط وی بی اسجاد شده است که با استفاده از این شماره می توانید کار هایی از قبیل خواندن و نوشتن روی فایل ایجاد شده را انجام دهید . دستور print اطلاعاتی که درون متغیر Vardata است را بر روی فایلمان می نویسد . خوب حالا ما اطلاعاتی را که درون متغیر vardata بود - مثلا mahdi valaee - را درون فایل نوشتیم . حالا می خواهیم آن را بخوانیم و درون متغیری دیگر بنام varinputing قرار دهیم . به کد زیر دقت کنید . این دفعه چون قصدمان خواندن از فایل است ، از پارامتر input استفاده نموده ایم .

open "C:\save.abc" for input as #2
input #1,varinputing
text1.text = varinputing
close #2

ما اطلاعاتی را که درون فایلمان بود را درون متغیری بنام varinputing قرار دادیم و سپس به خصوصیت text جعبه متن انتساب دادیم .
دیدی کاری نداشت ؟؟؟
با تشکر
منبع : www.vbcenter.blogfa.com (http://www.vbcenter.blogfa.com)

[30yamand]

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


Option Explicit
Dim gfatora As fatora
Dim gFileNum As Integer
Dim gRecordLen As Long
Dim gCurrentRecord As Long
Dim gLastRecord As Long



Private Sub txtfatora()
lblall.Caption = Trim(gfatora.all)
txtnum.Text = Trim(gfatora.num)
txtname.Text = Trim(gfatora.nam)
txtdate.Text = Trim(gfatora.date)
lbld0(12).Caption = Trim(gfatora.d(12))
For i = 0 To 11
txta(i).Text = Trim(gfatora.a(i))
txtb(i).Text = Trim(gfatora.b(i))
txtc(i).Text = Trim(gfatora.c(i))
lbld0(i).Caption = Trim(gfatora.d(i))
Next
End Sub

Private Sub txtnull()
lblall.Caption = ""
txtnum.Text = ""
txtname.Text = ""
txtdate.Text = date
lbld0(12).Caption = ""
For i = 0 To 11
txta(i).Text = ""
txtb(i).Text = ""
txtc(i).Text = ""
lbld0(i).Caption = ""
Next
End Sub


Private Sub fatoratxt()
If lblall.Caption = "" Then lblall.Caption = "0"
If Len(txtdate.Text) < 8 Then txtdate.Text = date
gfatora.all = lblall.Caption
gfatora.num = txtnum.Text
gfatora.nam = txtname.Text
gfatora.date = txtdate.Text
gfatora.d(12) = 0
For i = 0 To 11
If txta(i).Text = "" Then txta(i).Text = "0"
If txtb(i).Text = "" Then txtb(i).Text = "0"
gfatora.a(i) = txta(i).Text
gfatora.b(i) = txtb(i).Text
gfatora.c(i) = txtc(i).Text
gfatora.d(i) = txta(i).Text * txtb(i).Text
gfatora.d(12) = gfatora.d(12) + gfatora.d(i)
Next
End Sub


Private Sub SaveCurrentRecord()
fatoratxt
Put #gFileNum, gCurrentRecord, gfatora
End Sub




Private Sub ShowCurrentRecord()
Get #gFileNum, gCurrentRecord, gfatora
txtfatora
frmfatora1.Caption = "ÎÑíÏ : ÍÓÇÈ : " + _
Str(gCurrentRecord) + "/" + Str(gLastRecord)
lblrec.Caption = gCurrentRecord
txtnum.SetFocus
End Sub


Private Sub alltotal()
Dim RecN As Long
Dim at As Currency
For RecN = 1 To gCurrentRecord
Get #gFileNum, RecN, gfatora
at = at + gfatora.d(12)
Next
lblall.Caption = at
End Sub


Private Sub changed()
If lblall.Caption = "" Then lblall.Caption = "0"
If lbld0(12).Caption = "" Then lbld0(12).Caption = "0"
For i = 0 To 11
If txta(i).Text = "" Then txta(i).Text = "0"
If txtb(i).Text = "" Then txtb(i).Text = "0"
If lbld0(i).Caption = "" Then lbld0(i).Caption = "0"
Next
Dim change As Boolean
change = False
If lblall.Caption <> Trim(gfatora.all) Then
change = True
ElseIf txtnum.Text <> Trim(gfatora.num) Then
change = True
ElseIf txtname.Text <> Trim(gfatora.nam) Then
change = True
ElseIf txtdate.Text <> Trim(gfatora.date) Then
change = True
ElseIf lbld0(12).Caption <> Trim(gfatora.d(12)) Then
change = True
End If
For i = 0 To 11
If txta(i).Text <> Trim(gfatora.a(i)) Then
change = True
ElseIf txtb(i).Text <> Trim(gfatora.b(i)) Then
change = True
ElseIf txtc(i).Text <> Trim(gfatora.c(i)) Then
change = True
ElseIf lbld0(i).Caption <> Trim(gfatora.d(i)) Then
change = True
End If
Next
If change = True Then
If MsgBox("ÊÂíÇ ãí ÎæÇåíÏ Ñ˜æÏ ãæÑÏ äÙÑ ÑÇ ÊÛííÑ ÏåíÏ" + Chr(13) + Chr(13) + "ÂíÇ ãí ÎæåíÏ ÊÛíÑÇÊ ÑÇ ÐÎíÑå ˜äíÏ " + _
" ( " + Format(gCurrentRecord) + " ) " + "ÇÒ ÝÑæÔ ¿" _
, vbYesNo + vbExclamation + vbDefaultButton1 + vbMsgBoxRtlReading + vbMsgBoxRight, "ÐÎíÑå ÝÇíá") = 6 Then
mnusave_Click
End If
End If
End Sub


Private Sub DeleteCurrentRecord()
Dim DirResult
Dim TmpFileNum
Dim TmpPerson As fatora
Dim RecNum As Long
Dim TmpRecNum As Long
If MsgBox("ÂíÇ ãí ÎæÇåíÏ Ñ˜æÏ ãæÑÏ äÙÑ ÑÇ ÍÐÝ äãÇííÏ " + " ( " + Format(gCurrentRecord) + " ) " + "ÇÒ ÎÑíÏ ¿", vbYesNo + vbExclamation + vbDefaultButton1 + vbMsgBoxRtlReading + vbMsgBoxRight, "ÍÐÝ ÝÇíá") <> vbYes Then
txtnum.SetFocus
Exit Sub
End If
If Dir("fatora.TMP") = "fatora.TMP" Then
Kill "fatora.TMP"
End If
TmpFileNum = FreeFile
Open "fatora.TMP" For Random _
As TmpFileNum Len = gRecordLen
RecNum = 1
TmpRecNum = 1
Do While RecNum < gLastRecord + 1
If RecNum <> gCurrentRecord Then
Get #gFileNum, RecNum, TmpPerson
Put #TmpFileNum, TmpRecNum, TmpPerson
TmpRecNum = TmpRecNum + 1
End If
RecNum = RecNum + 1
Loop
Close gFileNum
Kill "ÎÑíÏ"
Close TmpFileNum
Name "fatora.TMP" As "ÎÑíÏ"
gFileNum = FreeFile
Open "ÎÑíÏ" For Random _
As gFileNum Len = gRecordLen
gLastRecord = gLastRecord - 1
If gLastRecord = 0 Then gLastRecord = 1
If gCurrentRecord > gLastRecord Then
gCurrentRecord = gLastRecord
End If
ShowCurrentRecord
txtnum.SetFocus
End Sub


Private Sub Search()
Dim NameToSearch As String
Dim Found As Boolean
Dim RecNum As Long
Dim TmpPerson As fatora
Dim intxt As Integer
NameToSearch = InputBox("æÇÑÏ ˜äíÏ äÇã ÑÇ ÈÑÇí ÌÓÊÌæ ", "ÈÌÓÊÌæ", "01/01/03")
If NameToSearch = "" Then
txtnum.SetFocus
Exit Sub
End If
NameToSearch = UCase(NameToSearch)
If Dir("Find1") = "Find1" Then
Kill "Find1"
End If
Dim free As Integer
Dim cur As Integer
free = FreeFile
Open "Find1" For Random As free Len = gRecordLen
For RecNum = 1 To gLastRecord
Found = False
Get #gFileNum, RecNum, TmpPerson
TmpPerson.nam = UCase(TmpPerson.nam)
intxt = InStr(TmpPerson.nam, NameToSearch)
If intxt >= 1 Then
Found = True
End If
If Found = True Then
gCurrentRecord = RecNum
ShowCurrentRecord
cur = cur + 1
Put #free, cur, gfatora
End If
Next
txtnum.SetFocus
Close gFileNum
Close free
gFileNum = FreeFile
Open "Find1" For Random _
As gFileNum Len = gRecordLen
gLastRecord = FileLen("Find1") / gRecordLen
If gLastRecord = 0 Then
gLastRecord = 1
End If
gCurrentRecord = gLastRecord
ShowCurrentRecord
Label6.Caption = Label6.Caption + " : " + NameToSearch
End Sub


Private Sub Search1()
Dim NameToSearch As String
Dim Found As Boolean
Dim RecNum As Long
Dim TmpPerson As fatora
Dim intxt As Integer
NameToSearch = InputBox("æÇÑÏ ˜äíÏ äÇã íÇ ÔãÇÑå íÇ ÊÇÑíÎ ÑÇ ÈÑÇí ÌÓÊÌæ ", "ÌÓÊÌæ", "01/01/03")
If NameToSearch = "" Then
txtnum.SetFocus
Exit Sub
End If
NameToSearch = UCase(NameToSearch)
Found = False
For RecNum = 1 To gLastRecord
Get #gFileNum, RecNum, TmpPerson
TmpPerson.nam = UCase(TmpPerson.nam)
intxt = InStr(TmpPerson.nam, NameToSearch)
If intxt >= 1 Then
Found = True
Exit For
Else
intxt = InStr(TmpPerson.num, NameToSearch)
End If
If intxt >= 1 Then
Found = True
Exit For
Else
intxt = InStr(TmpPerson.date, NameToSearch)
End If
If intxt >= 1 Then
Found = True
Exit For
End If
Next
If Found = True Then
SaveCurrentRecord
gCurrentRecord = RecNum
ShowCurrentRecord
Else
MsgBox "äÇã " + NameToSearch + " ãæÌæÏ äíÓÊ ", vbOKOnly + vbDefaultButton1 + vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÝǘÊæÑ"
End If
txtnum.SetFocus
End Sub


Private Sub updit()
Dim u As Long
For u = 1 To gLastRecord
gCurrentRecord = u
ShowCurrentRecord
alltotal
SaveCurrentRecord
Next
End Sub


Private Sub order()
Dim NameToSearch As String 'ÇÓã ÈÑÇí ÌÓÊÌæ
Dim Found As Boolean 'äÇã æ äÇã ÎÇäæÇϐí æÌæÏ ÏÇÑÏ íÇ äå
Dim RecNum As Long 'ÌÓÊÌæ ËÈÊ ÔÏå ÊæÓØ ÓäÈÑÇí ÇÓã
Dim RecNum1 As Long 'ÔãÇÑå ÝåÑÓÊ ÈÑÇí ÝåÑÓÊ ÌÚÈå ãÊä
Dim TmpPerson As fatora 'ãÊÛíÑ ÈÑÇí ÑæäÏå ÇÒ ÍÞæÞ ÌÏíÏ
Dim intxt As Integer 'ãÊÛíÑ ÈÑÇí ÑæäÏå ÇÒ ÍÞæÞ ÌÏíÏ
Dim free As Integer ' ÔãÇÑå ÑæäÏå ÈÑÇí ÝÇíá ÌÏíÏ
Dim cur As Integer ' ÔãÇÑå ËÈÊ Ñ˜æÑÏ ÝÚáí ÈÑÇí ÝÇíá ÌÏíÏ
free = FreeFile ' ÔãÇÑå ÂÒÇÏ ÈÑÇí ÝÇíá ÌÏíÏ
Open "Find4" For Random As free Len = gRecordLen 'ÈÇÒ ˜ÑÏä ÝÇíá ÌÏíÏ
For RecNum1 = 0 To List1.ListCount - 1 'ÍáÞå ÊÚÏÇÏí ÇÒ ãÊæä ãæÌæÏ
List1.ListIndex = RecNum1 'ÔãÇÑå ÑÏíÝ ÇÓã
If NameToSearch <> List1.Text Then
NameToSearch = List1.Text
Else
GoTo line 'ÒãÇäí ˜å ÇÓã ʘÑÇÑí ÈÇÔÏÏæÈÇÑå ËÈÊ äÇã ãí˜äÏ
End If
For RecNum = 1 To gLastRecord 'ÍáÞå ÑÏÔ ÈÑÇí ÇÓã
Found = False '
Get #gFileNum, RecNum, TmpPerson 'ËÈÊ ÊäÙíãÇÊ ãÊÛíÑ ÌÏíÏ
intxt = InStr(TmpPerson.nam, NameToSearch) '
If intxt >= 1 Then 'ÇÑ ãæÌæÏí ˜ÇÑǘÊÑ ÈÒѐÊÑ íÇ ãÓÇæí í˜ ÈÇÔÏ
Found = True '
End If '
If Found = True Then
gCurrentRecord = RecNum '
Get #gFileNum, gCurrentRecord, gfatora
cur = cur + 1
Put #free, cur, gfatora '
End If '
Next '
line:
Next '
txtnum.SetFocus '
Close gFileNum '
Close free '
If Dir("ÎÑíÏ") = "ÎÑíÏ" Then '
Kill "ÎÑíÏ" '
End If
Name "Find4" As "ÎÑíÏ"
gRecordLen = Len(gfatora)
gFileNum = FreeFile
Open "ÎÑíÏ" For Random _
As gFileNum Len = gRecordLen
gLastRecord = FileLen("ÎÑíÏ") / gRecordLen
If gLastRecord = 0 Then
gLastRecord = 1
End If
gCurrentRecord = gLastRecord
ShowCurrentRecord
End Sub



Private Sub Form_Activate()
sh2 = True
End Sub
Private Sub Form_Deactivate()
sh2 = False
End Sub


Private Sub Form_Load()
Dim PathName As String
PathName = App.Path
If Right(PathName, 1) <> "\" Then
PathName = PathName + "\"
End If
sh2 = True
On Error Resume Next
Image2.Picture = LoadPicture(PathName + "ÇáÎÊã" + ".wmf")
Dim l1, t1, S1, i1
l1 = GetSetting(App.EXEName, "v", "L1", True)
t1 = GetSetting(App.EXEName, "v", "T1", True)
S1 = GetSetting(App.EXEName, "v", "S1", True)
i1 = GetSetting(App.EXEName, "v", "i1", False)
Label2.Visible = l1
lblall.Visible = t1
Shape4.Visible = S1
Image2.Visible = i1
f2 = 0
gRecordLen = Len(gfatora)
gFileNum = FreeFile


Open "ÎÑíÏ" For Random _
As gFileNum Len = gRecordLen
gLastRecord = FileLen("ÎÑíÏ") / gRecordLen
If gLastRecord = 0 Then
gLastRecord = 1
End If
gCurrentRecord = gLastRecord
ShowCurrentRecord
End Sub


Private Sub Form_Unload(Cancel As Integer)
sh2 = False
SaveSetting App.EXEName, "v", "L1", Label2.Visible
SaveSetting App.EXEName, "v", "T1", lblall.Visible
SaveSetting App.EXEName, "v", "s1", Shape4.Visible
SaveSetting App.EXEName, "v", "i1", Image2.Visible
changed
Close gFileNum
End Sub


Private Sub Label6_Click()
If lblall.Visible = True Then
Label2.Visible = False
lblall.Visible = False
Shape4.Visible = False
Image2.Visible = True
Else
Label2.Visible = True
lblall.Visible = True
Shape4.Visible = True
Image2.Visible = False
End If
End Sub


Private Sub mnufileGRD_Click()
Unload frmfatora
Unload frmfatora1
FrmGRD.Show
End Sub


Public Sub mnuserchorder_Click()
Dim q As Integer
For q = 0 To List1.ListCount - 1
List1.RemoveItem 0
Next
For q = 1 To gLastRecord
Get #gFileNum, q, gfatora
List1.AddItem gfatora.nam
Next
order
updit
End Sub


Private Sub Timer1_Timer()
Lab1.Caption = Time
End Sub


Private Sub mnufilepurchases_Click()
frmfatora1.Show
MDIFatora.Arrange vbTileVertical
If mnuserchall.Enabled = False Then
mnuserchend_Click
End If
End Sub


Private Sub mnufilesold_Click()
frmfatora.Show
MDIFatora.Arrange vbTileVertical
If mnuserchall.Enabled = False Then
mnuserchend_Click
End If
End Sub


Private Sub mnufilegain_Click()
Dim gain As Currency
mnufilepurchases_Click
mnufilesold_Click
gain = frmfatora.lblall.Caption - frmfatora1.lblall.Caption
MDIFatora.Caption = "ÈÑäÇãå ÝǘÊæÑ: ÓæÏ äÇÎÇáÕ =" + " " + Str(gain)
End Sub


Private Sub mnufileexit_Click()
End
End Sub


Public Sub mnunew_Click()
On Error GoTo Line1
SaveCurrentRecord
alltotal
SaveCurrentRecord
gLastRecord = gLastRecord + 1
txtnull
fatoratxt
Put #gFileNum, gLastRecord, gfatora
gCurrentRecord = gLastRecord
ShowCurrentRecord
txtnull
txtnum.SetFocus
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


Public Sub mnusave_Click()
On Error GoTo Line1
SaveCurrentRecord
alltotal
SaveCurrentRecord
ShowCurrentRecord
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


Public Sub mnunext_Click()
On Error GoTo Line1
If gCurrentRecord = gLastRecord Then
Beep
MsgBox "ÑÓíÏ ÇäÊåÇí ÝÇíá !", vbOKOnly + vbDefaultButton1 + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÝǘÊæÑ"
Else
SaveCurrentRecord
gCurrentRecord = gCurrentRecord + 1
ShowCurrentRecord
End If
txtnum.SetFocus
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


Public Sub mnuprev_Click()
On Error GoTo Line1
If gCurrentRecord = 1 Then
Beep
MsgBox "ÑÓíÏ ÇÈÊÏÇí ÝÇíá !", vbOKOnly + vbDefaultButton1 + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÝǘÊæÑ"
Else
SaveCurrentRecord
gCurrentRecord = gCurrentRecord - 1
ShowCurrentRecord
End If
txtnum.SetFocus
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


Public Sub mnudelete_Click()
On Error GoTo Line1
DeleteCurrentRecord
GoTo Line2
Line1:
If Err.Number = 13 Then
MsgBox "ÇÑÒÔ åÇíí ˜å æÇÑÏ ÔÏå ÞÇÈá ÞÈæá äíÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
ElseIf Err.Number = 75 Then
MsgBox "ÝÇíá åÇí ÝÑæÔ ÝÞØ ÎæÇäÏäí ÇÓÊ !", vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
Else
MsgBox Err.Number, vbOKOnly + vbMsgBoxRight + vbInformation + vbMsgBoxRtlReading, "ÎØÇ"
End If
Line2:
End Sub


Public Sub mnuserchfirst_Click()
Search1
End Sub


Public Sub mnuserchall_Click()
mnuserchall.Enabled = False
mnudelete.Enabled = False
mnunew.Enabled = False
mnuserchorder.Enabled = False
Search
updit
End Sub


Public Sub mnuserchend_Click()
Close gFileNum
mnuserchall.Enabled = True
mnudelete.Enabled = True
mnunew.Enabled = True
mnuserchorder.Enabled = True
Form_Load
Label6.Caption = "ÍÓÇÈ"
End Sub


Public Sub mnuserchupdit_Click()
updit
End Sub
Public Sub mnuprint_Click()
PrintForm
End Sub


Public Sub mnuexit_Click()
f2 = 1
Unload Me
End Sub


Private Sub txta_GotFocus(Index As Integer)
txta(Index).SelStart = 0
txta(Index).SelLength = Len(txta(Index).Text)
End Sub


Private Sub txta_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case Is = 0
Select Case KeyCode
Case 40
txta(Index + 1).SetFocus 'v
Case 37
txtb(Index).SetFocus '>
End Select
Case Is < 11
Select Case KeyCode
Case 38
txta(Index - 1).SetFocus '^
Case 40
txta(Index + 1).SetFocus 'v
Case 37
txtb(Index).SetFocus '>
End Select
Case Is = 11
Select Case KeyCode
Case 38
txta(Index - 1).SetFocus '^
Case 37
txtb(Index).SetFocus '>
End Select
End Select
End Sub



Private Sub txtb_GotFocus(Index As Integer)
txtb(Index).SelStart = 0
txtb(Index).SelLength = Len(txtb(Index).Text)
End Sub


Private Sub txtb_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case Is = 0
Select Case KeyCode
Case 40
txtb(Index + 1).SetFocus 'v
Case 39
txta(Index).SetFocus '<
Case 37
txtc(Index).SetFocus '>
End Select
Case Is < 11
Select Case KeyCode
Case 38
txtb(Index - 1).SetFocus '^
Case 40
txtb(Index + 1).SetFocus 'v
Case 39
txta(Index).SetFocus '<
Case 37
txtc(Index).SetFocus '>
End Select
Case Is = 11
Select Case KeyCode
Case 38
txtb(Index - 1).SetFocus '^
Case 39
txta(Index).SetFocus '<
Case 37
txtc(Index).SetFocus '>
End Select
End Select
End Sub


Private Sub txtc_GotFocus(Index As Integer)
txtc(Index).SelStart = 0
txtc(Index).SelLength = Len(txtc(Index).Text)
End Sub



Private Sub txtc_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case Is = 0
Select Case KeyCode
Case 40
txtc(Index + 1).SetFocus 'v
Case 39
txtb(Index).SetFocus '<
End Select
Case Is < 11
Select Case KeyCode
Case 38
txtc(Index - 1).SetFocus '^
Case 40
txtc(Index + 1).SetFocus 'v
Case 39
txtb(Index).SetFocus '<
End Select
Case Is = 11
Select Case KeyCode
Case 38
txtc(Index - 1).SetFocus '^
Case 39
txtb(Index).SetFocus '<
End Select
End Select
End Sub



Private Sub txtdate_GotFocus()
txtdate.SelStart = 0
txtdate.SelLength = Len(txtdate.Text)
End Sub



Private Sub txtname_GotFocus()
txtname.SelStart = 0
txtname.SelLength = Len(txtname.Text)
End Sub
Private Sub txtnum_GotFocus()
txtnum.SelStart = 0
txtnum.SelLength = Len(txtnum.Text)
End Sub

[30yamand]

کد بالایی سورس یکی از فرمم ها است البته همش سه تا فرمو داره دوتاش که کدهاش شبیه هم هستند و دیگری فرم اصلی است که این دوتا فرم داخل او اجرا میشند (فرم های فرزند) اگه لازم بود بگید اون رو هم بزارم

[mr2010]

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

[fazelm]

این با فایل کار کرده

[mr2010]

یعنی چی از فایل استفاده کرده یکم توضیح بده برنامه رو ما هم یه چیزی گیرمون بیاد

[niko2008]

[PHP]

یعنی چی از فایل استفاده کرده یکم توضیح بده برنامه رو ما هم یه چیزی گیرمون بیاد

سلام دوست عزیز به نظر من بهترین روش برای ذخیر بدون دیتابیس استفاده از ایجاد فایل تصادفی است در این روش هم با استفاذه از رکوردست برای ذخیره فیلدها استفاده میشه
برای تعریف رکورد از دستور type استفاده میشه


public type personel
fname as string
lname as string
end type


در حقیقت رکوردی به نام personel تعریف کردیم که fname و lname فیلدهای آن میباشند

حال برای تعریف رکورد از نوع personel باید ارایه ای دو بعدی به نام مثلا m(1 to 2 تعریف

کرد.

حالا برای ثبت رکورد ها مینویسیم:


m(1).fname=text1.text

برای نمایش آن:


print m(1).fname

[vbhamed]

سلام

دوست عزيز، در اين تاپيك آموزش كار با فايلها به صورت تصويري توضيح داده شده است :

http://barnamenevis.org/forum/showthread.php?t=231746

(http://barnamenevis.org/forum/showthread.php?t=231607&page=2)

[30yamand]

دوست عزیز شما که لینک همین جا رو گذاشتی
و دوم اینکه این برنامه که ما گزاشتیم با چیزی که niko2008 توضیح دادن فرق داره اون چیزایی که ایشون میگن یه چیز ابتدایی هستش

[vbhamed]

دوست عزیز شما که لینک همین جا رو گذاشتی
و دوم اینکه این برنامه که ما گزاشتیم با چیزی که niko2008 توضیح دادن فرق داره اون چیزایی که ایشون میگن یه چیز ابتدایی هستش

سلام
شرمنده، لينك اصلاح شد
ولي اين توضيح كامل فايلهاست
مي تونيد باهاش اطلاعات رو ذخيره، ويرايش، حذف و ليست كنيد