[ Visual Basic 6 ] رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

تم تحميل الصفحة في 1,2931720 ثانية
رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة
الحالة
مغلق و غير مفتوح للمزيد من الردود.
إنضم
2 مارس 2007
المشاركات
7
الإعجابات
0
النقاط
0
مرحبا ...
اتمنى تكونو بصحة وعافية
الفكرة هي استخراج رقم مكون من 14 رقم من ملف بامتداد Vmg اذ تظهر لي رسالة الخطأ المرفق صورتها ادناه ! ارجو المساعدة بحل هذه المشكلة علما ان النموذج بالمرفقات للتعديل عليه ولكم مني كل التقدير




رابط تحميل المثال
http://www.4shared.com/file/X_3y-_W4/____.html


مع التقدير
 
إنضم
17 مايو 2008
المشاركات
439
الإعجابات
98
النقاط
28
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

غير السطر اللي فيه الخطأ بهذا السطر

كود:
 Input #hFile, sData
 
إنضم
2 مارس 2007
المشاركات
7
الإعجابات
0
النقاط
0
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

شكرا لك صديقي على مرورك ! تم معالجة المشكلة بالكود التالي لكن هناك سلبية في هذا الكود
في هذا الكود اعتمد استخراج التسلسل المكون من 15 خانة واخذ منه 14 خانة واهمال الخانة الاخيرة !! وهذا فعال ونجح بدون اخطاء
لكن
ان كان هناك اكثر من تسلسل متشابه ! اي انه بالملف يوجد رقمان مكونان من 15 خانة في هذه الحالة لن يعمل الكود لوجود متشابهين بالقيمة Len
lمثال:
الملف يحتوي رقمان متساويان بعدد الخانات لكنهما مختلفان بالقيمة
12345678954125, متبوع بفاصلة ","
56012305478014. متبوع بنقطة "."
المطلوب : استخراج التسلسل المتبوع ب "." واهمال الباقي
ما الكود الذي من خلاله يتم استخراج التسلسل المكون من 14 خانة والمتبوع ب "." فقط ؟؟؟؟

ولك مني كل التقدير


كود:
Private Declare Sub CoTaskMemFree Lib "Ole32.dll" (ByVal hMem As Long) 
Private Declare Function SHBrowseForFolder Lib "****************l32.dll" (lpbi As BrowseInfo) As Long 
Private Declare Function SHGetPathFromIDList Lib "****************l32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long 
 
Private Const BIF_RETURNONLYFSDIRS = 1 
Private Const Max_Path = 260 
 
Private Type BrowseInfo 
hWndOwner As Long 
pIDLRoot As Long 
pszDisplayName As Long 
lpszTitle As String 
ulFlags As Long 
lpfnCallback As Long 
lParam As Long 
iImage As Long 
End Type 
 
Private Sub Command1_Click() 
Dim lIDList As Long 
 
Dim PinCode As String 
Dim PathName As String 
Dim FileName As String 
 
Dim BrowseInfo As BrowseInfo 
 
With BrowseInfo 
.hWndOwner = Me.hWnd 
.lpszTitle = "Title of Dialog" 
.ulFlags = BIF_RETURNONLYFSDIRS 
End With 
 
lIDList = SHBrowseForFolder(BrowseInfo) 
 
If Not CBool(lIDList) Then Exit Sub 
 
Call Me.Combo1.Clear 
 
PathName = String(Max_Path, 0) 
 
Call SHGetPathFromIDList(lIDList, PathName) 
Call CoTaskMemFree(lIDList) 
 
If CBool(InStr(PathName, vbNullChar)) Then 
PathName = Mid(PathName, 1, InStr(PathName, vbNullChar) - 1) 
End If 
 
If Not (Right(PathName, 1) = "\") Then PathName = PathName & "\" 
 
FileName = Dir(PathName & "*.*", vbArchive Or vbHidden Or vbReadOnly Or vbSystem) 
 
Do While Len(FileName) > 0 
If (LCase(Right(FileName, 4)) = ".txt") Or (LCase(Right(FileName, 4)) = ".vmg") Then 
PinCode = GetPinCode(PathName & FileName) 
 
If Len(PinCode) > 0 Then 
Call Me.Combo1.AddItem(PinCode & " (" & FileName & ")") 
End If 
End If 
 
FileName = Dir() 
Loop 
End Sub 
 
Private Function GetPinCode(ByVal PathName As String) As String 
Dim sData As String 
Dim hFile As Integer 
Dim sTemp As String 
 
hFile = FreeFile 
 
Open PathName For Input As #hFile 
 
On Error Resume Next 
 
sData = Input(LOF(hFile), #hFile) 
 
If Err.Number = 62 Then 
Seek #hFile, 1 
sData = Input(LOF(hFile) / 2, #hFile) 
End If 
 
Close #hFile 
 
On Error GoTo 0 
 
Dim i1Loop As Integer 
Dim i2Loop As Integer 
 
Dim Lines() As String 
Dim Blocks() As String 
 
Lines = Split(sData, vbNewLine) 
 
For i1Loop = LBound(Lines) To UBound(Lines) 
Blocks = Split(Lines(i1Loop), Space(1)) 
 
For i2Loop = LBound(Blocks) To UBound(Blocks) 
 
If Len(Blocks(i2Loop)) = 14 Then 
If IsNumeric(Blocks(i2Loop)) Then 
GetPinCode = Blocks(i2Loop) 
Exit Function 
End If 
End If 
 
If Len(Blocks(i2Loop)) = 15 Then 
If IsNumeric(Left(Blocks(i2Loop), 14)) Then 
GetPinCode = Left(Blocks(i2Loop), 14) 
Exit Function 
End If 
End If 
 
Next i2Loop 
Next i1Loop 
 
Exit Function 
Err: 
 
Select Case Err.Number 
Case 62: Return 
End Select 
 
End Function
 
إنضم
17 مايو 2008
المشاركات
439
الإعجابات
98
النقاط
28
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

اعطيني ملف.vmg يكون فيه المثال اللي قلت عليه
 
إنضم
2 مارس 2007
المشاركات
7
الإعجابات
0
النقاط
0
إنضم
17 مايو 2008
المشاركات
439
الإعجابات
98
النقاط
28
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

الملف اللي اعطيتني يوجد فيه رقم واحد ب14 خانه
وانت قلت اذا كان يوجد رقمين بنفس عدد الخانات يفرق بينهم "," او "." في النهايه
ياليت تعطيني ملف يكون فيه رقمين كلهم 14 خانه ويفرق بينهم الفاصله او النقطه
 
إنضم
2 مارس 2007
المشاركات
7
الإعجابات
0
النقاط
0
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

الملف اللي اعطيتني يوجد فيه رقم واحد ب14 خانه
وانت قلت اذا كان يوجد رقمين بنفس عدد الخانات يفرق بينهم "," او "." في النهايه
ياليت تعطيني ملف يكون فيه رقمين كلهم 14 خانه ويفرق بينهم الفاصله او النقطه
حسنا
في الواقع ان الرقم المراد استخراجه من هذا الملف هو ذاك المكون من 11 خانة والمتبوع ب"." كما تلاحظه باخر الملف !! المشكلة بالكود المرفق في مشاركتي ان هذا الرقم المكون من 11 خانة يبدو وحيدا وما اتوقعه ان هناك رموزا مخفية مساوية لعدد خانات هذا الرقم الامر الذي يمنع استخراجه !

فالمطلوب صديقي هو استخراج الكود المكون من 11 خانة والمتبوع ب "." والظاهر باخر الملف واهمال اية اعداد اخرى مساوية له بعدد الخانات ...

سلمك الله
 
إنضم
17 مايو 2008
المشاركات
439
الإعجابات
98
النقاط
28
رد: رسالة خطأ عند تنفيذ كود استيراد رقم من ملف Vmg نوكيا بي سي سوت ارجو المساعدة

كود:
Private Declare Sub CoTaskMemFree Lib "Ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "****************l32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "****************l32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const Max_Path = 260
 
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
 
Private Sub Command1_Click()
Dim lIDList As Long
 
Dim PinCode As String
Dim PathName As String
Dim FileName As String
 
Dim BrowseInfo As BrowseInfo
 
With BrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = "Title of Dialog"
.ulFlags = BIF_RETURNONLYFSDIRS
End With
 
lIDList = SHBrowseForFolder(BrowseInfo)
 
If Not CBool(lIDList) Then Exit Sub
 
Call Me.Combo1.Clear
 
PathName = String(Max_Path, 0)
 
Call SHGetPathFromIDList(lIDList, PathName)
Call CoTaskMemFree(lIDList)
 
If CBool(InStr(PathName, vbNullChar)) Then
PathName = Mid(PathName, 1, InStr(PathName, vbNullChar) - 1)
End If
 
If Not (Right(PathName, 1) = "\") Then PathName = PathName & "\"
 
FileName = Dir(PathName & "*.*", vbArchive Or vbHidden Or vbReadOnly Or vbSystem)
 
Do While Len(FileName) > 0
If (LCase(Right(FileName, 4)) = ".txt") Or (LCase(Right(FileName, 4)) = ".vmg") Then
PinCode = GetPinCode(PathName & FileName)
 
If Len(PinCode) > 0 Then
Call Me.Combo1.AddItem(PinCode & " (" & FileName & ")")
End If
End If
 
FileName = Dir()
Loop
End Sub
 
Private Function GetPinCode(ByVal PathName As String) As String
Dim sData As String
Dim hFile As Integer
Dim sTemp As String
 
hFile = FreeFile
 
Open PathName For Input As #hFile
 
On Error Resume Next
 
sData = Input(LOF(hFile), #hFile)
 
If Err.Number = 62 Then
Seek #hFile, 1
sData = Input(LOF(hFile) / 2, #hFile)
End If
 
Close #hFile
 
On Error GoTo 0
 
Dim i1Loop As Integer
Dim i2Loop As Integer
 
Dim Lines() As String
Dim Blocks() As String
 
Lines = Split(sData, vbNewLine)
 
For i1Loop = LBound(Lines) To UBound(Lines)
Blocks = Split(Lines(i1Loop), Space(1))
 
For i2Loop = LBound(Blocks) To UBound(Blocks)
 
 If IsNumeric(Mid(Blocks(i2Loop), 1, 11)) Then
 If Mid(Blocks(i2Loop), 12, 1) = "." Then
GetPinCode = Left(Blocks(i2Loop), 11)
 
 End If
 End If
 
Next i2Loop
Next i1Loop
 
Exit Function
Err:
 
Select Case Err.Number
Case 62: Return
End Select
 
End Function
هذا بعد التعديل

لاتنسى تغير النجوم بكلمه sh ell من غير مسافه
 
الحالة
مغلق و غير مفتوح للمزيد من الردود.

الأعضاء النشطين حاليآ الذين يشاهدون هذا الموضوع (1 عضو و 0 ضيف)

خيارات الاستايل

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

إرجاع خيارات الإستايل