رسالة خطأ بكود استخراج رقم متسلسل من ملف Vmg نوكيا بي سي سوت ابحث عن حل

اخي هذا غريب جداً , فقد وجدت شئ غريب في هذا النوع من الملفات , فهذا النوع من الملفات يوجد به رموز غير مرئية بين الاحرف والارقام وهذا هو سبب الخطأ الذي ظهر معك , ولا يتعلق هذا الموضوع بإمتداد الملف , فقد قمت بتغيير امتداد الملف الى .txt ثم مسحت كل ما يوجد به وكتبت فقط 123 فوجدت ان الملف لا يحمل فقط هذا النص , بل يحمل بين كل رقم من هذه الارقام رمز خفي , والدليل على ذلك هو حجم الملف , فمن المفروض ان ملف محتواه 123 يكون حجمه 3 بايت فقط , ولكن هذا الملف حجمه 8 بايت , انظر الى الصورة للتوضيح :

* محتوى الملف :

* المحتوى الحقيقي :

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

إذا كانت صيغة الملف دائماً بهذا الشكل ( اي يوجد رقم الـ Pin Code في السطر الاول من المف ) ستطيع إستبدال السطر الذي يعطي الخطأ في الصورة بالسطر التالي :

 	Input #hFile, sData

لكن هذا فقط إذا كنت متأكد من ان الرقم دائماً يكون في السطر الاول من الملف ..

شكرا لمرورك اخي الكريم

ودعني اوضح المشكلة وما توصلت اليه

الفكرة عبارة عن كود يتغلل ملف بامتداد Vmg (نوكيا بي سي سوت ) ويقوم بالبحث داخل هذا الملف واستخراج تسلسل رقمي مكون من 14 خانة ويقوم بنسخه وطباعته داخل كومبو مثلا !!

تم حل المشكلة السابقة بمجهود مبارك من احد المبرمجين وتخلصنا من الرسالة السابقة ..... لكن !

المشكلة الجديدة هي ان الرقم المتسلسل بداخل الملف Vmg متبوع بنقطة "." الامر الذي اعاق سير الكود وان الكود يعمل جيدا في حال وضع مسافة بين الرقم المتسلسل و "."

مثال :

12345678912345. التسلسل التالي متبوع ب "." بدون مسافة لا يتم الاستخراج

12345678912345 التسلسل التالي بدون "." يتم الاستخراج

المطلوب : تجاهل النقطة بالتسلسل واستخراج الرقم المكون من 14 خانة رغم وجود "." ملاصقة له .

الكود المستخدم بالمشروع:

Private Declare Sub CoTaskMemFree Lib "Ole32.dll" (ByVal hMem As Long)

Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32.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

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

Next i2Loop

Next i1Loop

Exit Function

Err:

Select Case Err.Number

Case 62: Return

End Select

End Function

جرب هذا الكود :

Private Declare Sub CoTaskMemFree Lib "Ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.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

شكرا لك صديقي محمد على المشاركة لكن لي استفسار

في طريقتك اعتمد استخراج التسلسل المكون من 15 خانة واخذ منه 14 خانة واهمال الخانة الاخيرة !! وهذا فعال ونجح بدون اخطاء

لكن

ان كان هناك اكثر من تسلسل متشابه ! اي انه بالملف يوجد رقمان مكونان من 15 خانة في هذه الحالة لن يعمل الكود لوجود متشابهين بالقيمة Len

lمثال:

الملف يحتوي رقمان متساويان بعدد الخانات لكنهما مختلفان بالقيمة

12345678954125, متبوع بفاصلة ","

56012305478014. متبوع بنقطة "."

المطلوب : استخراج التسلسل المتبوع ب "." واهمال الباقي

ما الكود الذي من خلاله يتم استخراج التسلسل المكون من 14 خانة والمتبوع ب "." فقط ؟؟؟؟

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

في احد الملفات التي ارفقتها كمثال :

اقتباس

PIN for voucher of MRP 1 from retailer 88695602 is 28014685689881, Trasaction ID is E101219.1228.20026 and serial number is 88512741472.END

هنا الـ Pin Code مكون من 14 خانة متبوع بفاصلة "28014685689881,"

والـ Serial Number مكون من 11 خانة متبوع بنقطة "88512741472."

ايهما تريد إستخراجه ؟؟!

اقتباس

ما الكود الذي من خلاله يتم استخراج التسلسل المكون من 14 خانة والمتبوع ب "." فقط ؟؟؟؟

حسناً , الكود التالي يقوم بما ذكرته , اي انه يستخرج التسلسل المكون من 14 خانة والمتبوع بـ "." فقط

Private Declare Sub CoTaskMemFree Lib "Ole32.dll" (ByVal hMem As Long)
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.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)) And Right(Blocks(i2Loop), 1) = "." 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

لكنه لم يعمل مع الملفات التي ارفقتها كمثال , لماذا ؟؟ لانه لا يوجد بالملف تسلسل مكون من 14 خانة متبوع بنقطة

الرقم المتبوع بنقطة مكون من 11 خانة فقط والرقم المكون من 14 خانة متبوع بفاصلة لذلك لن يتم إستخراج اي تسلسل ..

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

إن إستطعت ان تحصل على مواصفات لهذا التسلسل لا يتشارك معه فيها اي تسلسل اخر في الملف ولا تتغير هذه المواصفات من ملف لملف , حينها نستطيع عمل الكود المطلوب لإستخراج التسلسل المطلوب ..

قمت بتجربة الكود وهو يعمل مع التسلسل 14 خانة بشكل جيد

لكني قمت بتغير من 14 الى 11 لنفس الكود لم تنجح العملية !!

ما التغير الواجب فعله لاستخراج التسلسل 11 خانة والمتبوع ب"." كما تفضلت انت سابقا ؟ 88512741472.

وشكرا لجهودك اخي محمد

بصراحة !!!

اتعبتني هالمشكلة :wacko:

قم بإستبدال هذا الجزء :

If Len(Blocks(i2Loop)) = 15 Then
If IsNumeric(Left(Blocks(i2Loop), 14)) And Right(Blocks(i2Loop), 1) = "." Then
GetPinCode = Left(Blocks(i2Loop), 14)
Exit Function
End If
End If

بهذا الجزء :

If Len(Blocks(i2Loop)) >= 12 Then 
If IsNumeric(Left(Blocks(i2Loop), 11)) And Mid(Blocks(i2Loop), 12, 1) = "." Then
GetPinCode = Left(Blocks(i2Loop), 11)
Exit Function
End If
End If

* في الكود الاول يستخرج التسلسل الذي ينطبق عليه الشروط الاتية :

- ان يكون التسلسل مكون من 15 خانة اول 14 خانة منهم رقم واخر خانة النقطة "." وان يكون قبل التسلسل مسافة وبعده ( بعد النقطة ) مسافة

اما في تسلسل الـ Serial Number يكون قبله مسافة لكن لا يوجد بعده مسافة مثل "is 88512739912.END"

* ففي الكود الثاني يستخرج التسلسل الذي ينطبق عليه الشروط الاتية :

-ان يكون مكون من 12 خانة او اكثر ويشطرت ان تكون اول 11 خانة رقم ويتبعها نقطة "." وان يكون قبل التسلسل مسافة وبعده ( بعد النقطة ) لا يشطرت وجود مسافة.

محمد مصطفى غريب

هم كلمتين ................... روح يا شيخ روووووووووووووووح

ربنا يديك الصحة والعافية ويفك ديقتك يا شيخ

هو دة الكلام صح الكود مية بالمية

شكرا جزيلا لك يا صديقي ابدعت

بالتوفيق

مرحبا صديقي محمد

في ملف اخر هناك رقمان متشابهان في الخانات مختلفان بالقيمة وايضا ليست ارقاما بل حروف ايضا واليك محتوى الملف :

Date:28.12.2010 17:57:32

Message 1 of 1 Denom: 1.000 Code(s):93839437206976 , and Serial(s):123625412542 Expiry: 2011-Dec-18 Ref ID: 101228100007036

التسلسل : Code(s):93839437206976 و التسلسل : Serial(s):123625412542

يحملان نفس عدد الخانات 22 والمراد استخراج الرقم فقط من كل تسلسل !!

حاولت بتغير الاكواد السابقة لكن لم تنجح العملية !!

ما التعديل الواجب عمله ليتم استخراج الارقام من تلك المتسلسلتين

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

* لإستخراج الرقم الموجود بالتسلسل الذي ينطبق عليه الشروط التالية :

1) يتكون التسلسل من 22 خانة

2) يبدأ التسلسل بالمقطع "Code(s):" والـ 14 خانة الاخرى تكون رقم

- استخدم :

If Len(Blocks(i2Loop)) = 22 Then
If Left(Blocks(i2Loop), 8) = "Code(s):" And IsNumeric(Right(Blocks(i2Loop), 14)) Then
GetPinCode = Right(Blocks(i2Loop), 14)
Exit Function
End If
End If

* لإستخراج الرقم الموجود بالتسلسل الذي ينطبق عليه الشروط التالية :

1) يتكون التسلسل من 22 خانة

2) يبدأ التسلسل بالمقطع "Serial(s):" والـ 12 خانة الاخرى تكون رقم

- استخدم :

If Len(Blocks(i2Loop)) = 22 Then
If Left(Blocks(i2Loop), 10) = "Serial(s):" And IsNumeric(Right(Blocks(i2Loop), 12)) Then
GetPinCode = Right(Blocks(i2Loop), 12)
Exit Function
End If
End If

ارجوا ان يكون الكود واضح لتستطيع إستخدامه وتعديله كما تشاء , يمكنني شرح دوال التعامل مع النصوص إذا اردت لتستطيع تعديل الكود حسب ما تريد لتكون الفائدة حقيقية ,,,

بارك الله لك وعليك ودمت معلما لنا

الكود يعمل جيدا ولك كل التقدير