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

[bah69man]

عکسشو دادم دیگه

[Mr.pRoGraMmer]

سورستو بزار
تا ببینم

[bah69man]

سورسو دانلود کن داداش حامد گذاشته ولی وقتی میخوام ببرم رو فرم دیگه
اینو میده

[Mr.pRoGraMmer]

عجب
این سورس سریال هارد دیسکو میده همین
دیکه کاری به رجیستری نداره
یه تابع داره
باید اینجوری تابع رو صدا بزنی

کد:

Private Declare Function GetVolumeSerialNumber Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long



Private Sub Form_Load()
Text1.Text = DiscSerialNumber("C:\")

End Sub

Public Function DiscSerialNumber(ByVal RootPath As String) As String
    Dim VolLabel As String
    Dim VolSize As Long
    Dim Serial As Long
    Dim MaxLen As Long
    Dim Flags As Long
    Dim Name As String
    Dim NameSize As Long
    Dim S As String
    Dim ret As Boolean
    ret = GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name, NameSize)
    If ret Then
        S = Format(Hex(Serial), "00000000")
        DiscSerialNumber = Left(S, 4) + "-" + Right(S, 4)
    Else
        DiscSerialNumber = "0000-0000"
    End If
End Function

یه تکست باکس هم رو فرمت بزار الان شما سریالو بدست اوری
حالا برو سراغ کلیدش در رجیستری

[bah69man]

بازم همون مشکلو داره

[Mr.pRoGraMmer]

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

[bah69man]

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

---

یه خواهش از شما
شما خودتون همچین سورسی دارین؟

چشم حتما کتابو میخونم

[hamed_Arfaee]

فکر کنم بدونم بخاطر چی ارور میده
از این استفاده کن :

اگه خوب انتقالش بدی دیگه خطا نمیده :p

[bah69man]

بازم همون مشکل داداش
شرمنده اینقدر اذیتتون کردم

---

من الان خودم اینو جدا از اینا دارم ولی واسه همه یه سریال میده نمیدونم مرضش کجاس

کد:

Private Sub Command1_Click()
On Error GoTo faraz

If Text2.Text = (val(Text1.Text) + 88.33) / 0.2 Then
SetStringValue "HKEY_CURRENT_USER\Software\Policies\Microsoft\WindowsMediaPlayer\9.0\wmp", "compliteed", "yes"
frmMain.Show
Me.Hide
Else
faraz: MsgBox "ãÞÏÇÑ æÇÑÏ ÔÏå ÕÍíÍ äãí ÈÇÔÏ"
End If
'310455.4
'310533.4
End Sub
Private Sub Form_Load()
On Error Resume Next
CreateKey "HKEY_CURRENT_USER\Software\Policies\Microsoft\WindowsMediaPlayer\9.0\wmp"
Dim adadtolidsode As String
adadtolidsode = Rnd * 10000 * 88 + 9
Text1.Text = adadtolidsode
''''''''''''''''''''''''''''
Dim asli As String
asli = GetStringValue("HKEY_CURRENT_USER\Software\Policies\Microsoft\WindowsMediaPlayer\9.0\wmp", "compliteed")
Label(0).Caption = asli
If Label(0).Caption = "yes" Then
frmMain.Show
Me.Hide
End If




End Sub

Private Sub Image1_Click()
End
End Sub

[hamed_Arfaee]

اینا رو بیخیال شو

یک ساعت با اون کدی که بهت دادم (زیاد هم نیستن همش 70-80 خطه )ور بری زیر و بمش میاد دستت .

اگرم نتونستی انتقالش بدی تو پروژت راه بهتر اینه که پروژتو انتقال بدی تو این

در کل اشکال از خودته نه جای دیگه .
میخواهی بدون زحمت یه چیزی رو صاحب بشی اینم نمیشه .

یکم زحمت بکش همه چیز حل میشه .

[bah69man]

مرس داداش حامد

میرم چند ماهی بخونم تا یاد بگیرم با اینکه فردا باید اینو تحویل میدادم

بازم منون از لطفتون داداش