Как преобразовать код в шестнадцатеричный формат с помощью vb6
Я хочу сохранить значения, приведенные в vb6, в текстовый файл в шестнадцатеричном формате
В настоящее время я использую MSACCESS в качестве базы данных, но хочу использовать текстовый файл, избегая MSACCESS
Например формат hex должен быть таким
:10010000214601360121470136007EFE09D2190140
:100110002146017E17C20001FF5F16002148011928
:10012000194E79234623965778239EDA3F01B2CAA7
:100130003F0156702B5E712B722B732146013421C7
:00000001FF
Пожалуйста, помогите мне
[edit]добавлен блок кода - OriginalGriff[/edit]
Что я уже пробовал:
Option Explicit Dim con As New adodb.Connection Dim rs As New adodb.Recordset Dim str As String Dim bytes() As Byte Dim i, fil1 As Integer Dim x As Long Dim strng, hexcod, methd, fil2, slpe, prntr, usrloc, str1 As String Dim temp, unit, stndrd, reagvol, smplevol, aspvol, conc, factr, read, delta, delay, linear, minval, maxval As Double Private Sub glucose_Click() Label26.Caption = "" & glucose.Caption End Sub Private Sub chol_Click() Label26.Caption = "" & chol.Caption End Sub Private Sub bun_Click() Label26.Caption = "" & bun.Caption End Sub Private Sub crtn_Click() Label26.Caption = "" & crtn.Caption End Sub Private Sub urea_Click() Label26.Caption = "" & urea.Caption End Sub Private Sub trig_Click() Label26.Caption = "" & trig.Caption End Sub Private Sub sgot_Click() Label26.Caption = "" & sgot.Caption End Sub Private Sub sgpt_Click() Label26.Caption = "" & sgpt.Caption End Sub Private Sub hdl_Click() Label26.Caption = "" & hdl.Caption End Sub Private Sub ldl_Click() Label26.Caption = "" & ldl.Caption End Sub Private Sub ck_Click() Label26.Caption = "" & ck.Caption End Sub Private Sub ckmb_Click() Label26.Caption = "" & ckmb.Caption End Sub Private Sub d_bil_Click() Label26.Caption = "" & d_bil.Caption End Sub Private Sub t_bil_Click() Label26.Caption = "" & t_bil.Caption End Sub Private Sub ldh_Click() Label26.Caption = "" & ldh.Caption End Sub Private Sub aklp_Click() Label26.Caption = "" & aklp.Caption End Sub Private Sub alb_Click() Label26.Caption = "" & alb.Caption End Sub Private Sub tpr_Click() Label26.Caption = "" & tpr.Caption End Sub Private Sub a_amy_Click() Label26.Caption = "" & a_amy.Caption End Sub Private Sub g_gt_Click() Label26.Caption = "" & g_gt.Caption End Sub Private Sub ca_Click() Label26.Caption = "" & ca.Caption End Sub Private Sub phos_Click() Label26.Caption = "" & phos.Caption End Sub Private Sub fe_Click() Label26.Caption = "" & fe.Caption End Sub Private Sub cl_Click() Label26.Caption = "" & cl.Caption End Sub Private Sub uric_Click() Label26.Caption = "" & uric.Caption End Sub Private Sub ghb_Click() Label26.Caption = "" & ghb.Caption End Sub Private Sub na_Click() Label26.Caption = "" & na.Caption End Sub Private Sub k_Click() Label26.Caption = "" & k.Caption End Sub Sub display() Dim a As Long Dim meth, filt1, filt2, tem, prnt, loc, slp, unt, stnd, regvol, fctr, readtme, dly, dlta, lin, normin, normax, asp, smple, concen As String 'If Label26.Caption = rs!nameoftest Then Combo1.Text = rs!method methd = Combo1.Text For a = 1 To Len(methd) Step 2 meth = meth & Chr(Val("&H" & Mid$(methd, a, 2))) Next Combo1.Text = meth Combo2.Text = rs!filter1 fil1 = Combo2.Text filt1 = CInt("&H" & fil1) Combo2.Text = filt1 Combo3.Text = rs!filter2 fil2 = Combo3.Text For a = 1 To Len(fil2) Step 2 filt2 = filt2 & Chr(Val("&H" & Mid$(fil2, a, 2))) Next Combo3.Text = filt2 Combo4.Text = rs!temperature temp = Combo4.Text tem = CInt("&H" & temp) Combo4.Text = tem Text5.Text = rs!units unit = Text5.Text unt = CInt("&H" & unit) Text5.Text = unt Text6.Text = rs!nostandards stndrd = Text6.Text stnd = CInt("&H" & stndrd) Text6.Text = stnd Text7.Text = rs!reagentvolume reagvol = Text7.Text regvol = CInt("&H" & reagvol) Text7.Text = regvol Text8.Text = rs!samplevolume smplevol = Text8.Text smple = CInt("&H" & smplevol) Text8.Text = smple Text9.Text = rs!aspirationvolume aspvol = Text9.Text asp = CInt("&H" & aspvol) Text9.Text = asp Text10.Text = rs!concentration conc = Text10.Text concen = CInt("&H" & conc) Text10.Text = concen Text11.Text = rs!factor factr = Text11.Text fctr = CInt("&H" & factr) Text11.Text = fctr Text12.Text = rs!readtime read = Text12.Text readtme = CInt("&H" & read) Text12.Text = readtme Text13.Text = rs!deltatime delta = Text13.Text dlta = CInt("&H" & delta) Text13.Text = dlta Text14.Text = rs!delaytime delay = Text14.Text dly = CInt("&H" & delay) Text14.Text = dly Text15.Text = rs!linearity linear = Text15.Text lin = CInt("&H" & linear) Text15.Text = lin Text16.Text = rs!normalminvalue minval = Text16.Text normin = CInt("&H" & minval) Text16.Text = normin Text17.Text = rs!normalmaxvalue maxval = Text17.Text normax = CInt("&H" & maxval) Text17.Text = normax Text18.Text = rs!printeronoff prntr = Text18.Text For a = 1 To Len(prntr) Step 2 prnt = prnt & Chr(Val("&H" & Mid$(prntr, a, 2))) Next Text18.Text = prnt Text19.Text = rs!UserLocation usrloc = Text19.Text For a = 1 To Len(usrloc) Step 2 loc = loc & Chr(Val("&H" & Mid$(usrloc, a, 2))) Next Text19.Text = loc Combo5.Text = rs!slope slpe = Combo5.Text For a = 1 To Len(slpe) Step 2 slp = slp & Chr(Val("&H" & Mid$(slpe, a, 2))) Next Combo5.Text = slp 'End If End Sub Private Sub Form_Load() con.Open "PROVIDER= Microsoft.Jet.OLEDB.4.0;data source=C:\Users\Raghava\Desktop\Database\artoss.mdb;" rs.Open "Select * from Table1", con, adOpenDynamic, adLockPessimistic 'rs.Open "Select * from Table1 where NameofTest='" & Label26.Caption & "'", con, adOpenKeyset, adLockPessimistic clear End Sub Private Sub save_data_Click() rs.AddNew ' //////name of test/////// str = Label26.Caption bytes = StrConv(str, vbFromUnicode) str = "" For i = LBound(bytes) To UBound(bytes) str = str & Format$(Hex$(bytes(i)), "00") 'Print #1, "DOM" & <fs> & TempList.Fields("TLGRef").Value & <fs> & <lf> Next i Label26.Caption = str str = StrConv(bytes, vbUnicode) rs.Fields("NameofTest").Value = Label26.Caption ' ////method//////// methd = Combo1.Text bytes = StrConv(methd, vbFromUnicode) methd = "" For i = LBound(bytes) To UBound(bytes) methd = methd & Format$(Hex$(bytes(i)), "00") Next i Combo1.Text = methd methd = StrConv(bytes, vbUnicode) rs.Fields("Method").Value = Combo1.Text ' ////filter1//////// fil1 = Combo2.Text Do While fil1 > 0 strng = fil1 Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng fil1 = fil1 / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Filter1").Value = hexcod ' ////filter2//////// fil2 = Combo3.Text bytes = StrConv(fil2, vbFromUnicode) fil2 = "" For i = LBound(bytes) To UBound(bytes) fil2 = fil2 & Format$(Hex$(bytes(i)), "00") Next i Combo3.Text = fil2 fil2 = StrConv(bytes, vbUnicode) rs.Fields("Filter2").Value = Combo3.Text ' ////temperature///// strng = "" hexcod = "" temp = Combo4.Text Do While temp > 0 strng = temp Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng temp = temp / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Temperature").Value = hexcod ' /////units////// strng = "" hexcod = "" unit = Text5.Text Do While unit > 0 strng = unit Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng unit = unit / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Units").Value = hexcod ' ////no.of standards//////// strng = "" hexcod = "" stndrd = Text6.Text Do While stndrd > 0 strng = stndrd Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng stndrd = stndrd / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NoStandards").Value = hexcod ' ////reagent vol///////// strng = "" hexcod = "" reagvol = Text7.Text Do While reagvol > 0 strng = reagvol Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng reagvol = reagvol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("ReagentVolume").Value = hexcod ' ////sample vol///// strng = "" hexcod = "" smplevol = Text8.Text Do While smplevol > 0 strng = smplevol Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng smplevol = smplevol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("SampleVolume").Value = hexcod ' ////aspiration volume//// strng = "" hexcod = "" aspvol = Text9.Text Do While aspvol > 0 strng = aspvol Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng aspvol = aspvol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("AspirationVolume").Value = hexcod ' ///concentration/// strng = "" hexcod = "" conc = Text10.Text Do While conc > 0 strng = conc Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng conc = conc / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Concentration").Value = hexcod ' ///factor/// strng = "" hexcod = "" factr = Text11.Text Do While factr > 0 strng = factr Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng factr = factr / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Factor").Value = hexcod ' ///read time//// strng = "" hexcod = "" read = Text12.Text Do While read > 0 strng = read Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng read = read / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("ReadTime").Value = hexcod ' ///delta time/// strng = "" hexcod = "" delta = Text13.Text Do While delta > 0 strng = delta Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng delta = delta / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("DeltaTime").Value = hexcod ' ////delay time//// strng = "" hexcod = "" delay = Text14.Text Do While delay > 0 strng = delay Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng delay = delay / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("DelayTime").Value = hexcod ' ////slope//// slpe = Combo5.Text bytes = StrConv(slpe, vbFromUnicode) slpe = "" For i = LBound(bytes) To UBound(bytes) slpe = slpe & Format$(Hex$(bytes(i)), "00") Next i Combo5.Text = slpe slpe = StrConv(bytes, vbUnicode) rs.Fields("slope").Value = Combo5.Text ' ///linearity//// strng = "" hexcod = "" linear = Text15.Text Do While linear > 0 strng = linear Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng linear = linear / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Linearity").Value = hexcod ' ////nor min val//// strng = "" hexcod = "" minval = Text16.Text Do While minval > 0 strng = minval Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng minval = minval / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NormalMinValue").Value = hexcod ' ////nor max val//// strng = "" hexcod = "" maxval = Text17.Text Do While maxval > 0 strng = maxval Mod 16 If strng > 9 Then strng = Chr(CInt(strng) + 55) End If hexcod = hexcod & strng maxval = maxval / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NormalMaxValue").Value = hexcod ' ///printer on/off//// prntr = Text18.Text bytes = StrConv(prntr, vbFromUnicode) prntr = "" For i = LBound(bytes) To UBound(bytes) prntr = prntr & Format$(Hex$(bytes(i)), "00") Next i Text18.Text = prntr prntr = StrConv(bytes, vbUnicode) rs.Fields("Printeronoff").Value = Text18.Text ' /////user location//// usrloc = Text19.Text bytes = StrConv(usrloc, vbFromUnicode) usrloc = "" For i = LBound(bytes) To UBound(bytes) usrloc = usrloc & Format$(Hex$(bytes(i)), "00") Next i Text19.Text = usrloc usrloc = StrConv(bytes, vbUnicode) rs.Fields("UserLocation").Value = Text19.Text clear MsgBox "Data is saved successfully...!!", vbInformation rs.update End Sub Sub clear() Label26.Caption = "" Combo1.Text = "Select a Method" Combo2.Text = "Nil" Combo3.Text = "Nil" Combo4.Text = "Nil" Combo5.Text = "Nil" Text5.Text = "" Text6.Text = "" Text7.Text = "" Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" Text13.Text = "" Text14.Text = "" Text15.Text = "" Text16.Text = "" Text17.Text = "" Text18.Text = "" Text19.Text = "" End Sub Private Sub delete_Click() Dim confirm confirm = MsgBox("Do You want to delete the data?", vbYesNo + vbCritical, "Deletion Confirmation") If confirm = vbYes Then rs.delete adAffectCurrent MsgBox "Record has been deleted successfully", vbInformation, "Message" rs.update Else MsgBox "Data not deleted...!!", vbInformation, "Message" End If clear End Sub Private Sub view_Click() Label26.Caption = rs!NameofTest 'con.Open "PROVIDER= Microsoft.Jet.OLEDB.4.0;data source=C:\Users\Raghava\Desktop\Database\artoss.mdb;" 'con.CursorLocation = adUseClient 'con.Open rs.Close rs.Open "Select * from Table1 where NameofTest='" + Label26.Caption + "'", con, adOpenDynamic, adLockPessimistic str = Label26.Caption For x = 1 To Len(str) Step 2 str1 = str1 & Chr(Val("&H" & Mid$(str, x, 2))) Next Label26.Caption = str1 If Not rs.EOF Then display Else MsgBox "Record not Found..!!", vbInformation Label26.Caption = "" End If 'Set rs = Nothing End Sub Private Sub ok_Click() clear End Sub Private Sub cancel_Click() End End Sub Private Sub update_Click() ' ////method//////// methd = Combo1.Text bytes = StrConv(methd, vbFromUnicode) methd = "" For i = LBound(bytes) To UBound(bytes) methd = methd & Format$(Hex$(bytes(i)), "00") Next i Combo1.Text = methd methd = StrConv(bytes, vbUnicode) rs.Fields("Method").Value = Combo1.Text ' ////filter1//////// fil1 = Combo2.Text Do While fil1 > 0 strng = fil1 Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng fil1 = fil1 / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Filter1").Value = hexcod ' ////filter2//////// fil2 = Combo3.Text bytes = StrConv(fil2, vbFromUnicode) fil2 = "" For i = LBound(bytes) To UBound(bytes) fil2 = fil2 & Format$(Hex$(bytes(i)), "00") Next i Combo3.Text = fil2 fil2 = StrConv(bytes, vbUnicode) rs.Fields("Filter2").Value = Combo3.Text ' ////temperature///// strng = "" hexcod = "" temp = Combo4.Text Do While temp > 0 strng = temp Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng temp = temp / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Temperature").Value = hexcod ' /////units////// strng = "" hexcod = "" unit = Text5.Text Do While unit > 0 strng = unit Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng unit = unit / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Units").Value = hexcod ' ////no.of standards//////// strng = "" hexcod = "" stndrd = Text6.Text Do While stndrd > 0 strng = stndrd Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng stndrd = stndrd / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NoStandards").Value = hexcod ' ////reagent vol///////// strng = "" hexcod = "" reagvol = Text7.Text Do While reagvol > 0 strng = reagvol Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng reagvol = reagvol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("ReagentVolume").Value = hexcod ' ////sample vol///// strng = "" hexcod = "" smplevol = Text8.Text Do While smplevol > 0 strng = smplevol Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng smplevol = smplevol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("SampleVolume").Value = hexcod ' ////aspiration volume//// strng = "" hexcod = "" aspvol = Text9.Text Do While aspvol > 0 strng = aspvol Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng aspvol = aspvol / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("AspirationVolume").Value = hexcod ' ///concentration/// strng = "" hexcod = "" conc = Text10.Text Do While conc > 0 strng = conc Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng conc = conc / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Concentration").Value = hexcod ' ///factor/// strng = "" hexcod = "" factr = Text11.Text Do While factr > 0 strng = factr Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng factr = factr / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Factor").Value = hexcod ' ///read time//// strng = "" hexcod = "" read = Text12.Text Do While read > 0 strng = read Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng read = read / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("ReadTime").Value = hexcod ' ///delta time/// strng = "" hexcod = "" delta = Text13.Text Do While delta > 0 strng = delta Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng delta = delta / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("DeltaTime").Value = hexcod ' ///delay time//// strng = "" hexcod = "" delay = Text14.Text Do While delay > 0 strng = delay Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng delay = delay / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("DelayTime").Value = hexcod ' ////slope//// slpe = Combo5.Text bytes = StrConv(slpe, vbFromUnicode) slpe = "" For i = LBound(bytes) To UBound(bytes) slpe = slpe & Format$(Hex$(bytes(i)), "00") Next i Combo5.Text = slpe slpe = StrConv(bytes, vbUnicode) rs.Fields("slope").Value = Combo5.Text ' ///linearity//// strng = "" hexcod = "" linear = Text15.Text Do While linear > 0 strng = linear Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng linear = linear / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("Linearity").Value = hexcod ' ////nor min val//// strng = "" hexcod = "" minval = Text16.Text Do While minval > 0 strng = minval Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng minval = minval / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NormalMinValue").Value = hexcod ' ////nor max val//// strng = "" hexcod = "" maxval = Text17.Text Do While maxval > 0 strng = maxval Mod 16 If strng > 9 Then strng = Chr(CInt(strng)) End If hexcod = hexcod & strng maxval = maxval / 16 Loop hexcod = StrReverse(hexcod) rs.Fields("NormalMaxValue").Value = hexcod ' ///printer on/off//// prntr = Text18.Text bytes = StrConv(prntr, vbFromUnicode) prntr = "" For i = LBound(bytes) To UBound(bytes) prntr = prntr & Format$(Hex$(bytes(i)), "00") Next i Text18.Text = prntr prntr = StrConv(bytes, vbUnicode) rs.Fields("Printeronoff").Value = Text18.Text ' /////user location//// usrloc = Text19.Text bytes = StrConv(usrloc, vbFromUnicode) usrloc = "" For i = LBound(bytes) To UBound(bytes) usrloc = usrloc & Format$(Hex$(bytes(i)), "00") Next i Text19.Text = usrloc usrloc = StrConv(bytes, vbUnicode) MsgBox "Data is updated successfully...!!", vbInformation rs.update clear End Sub
OriginalGriff
Здесь есть пара вещей:
1) это дамп кода - и это грубо. Вы говорите: "мне все равно, вы пробираетесь через эту недокументированную кучу и выясняете, что, черт возьми, я имею в виду, потому что меня это не беспокоит". Используйте виджет "улучшить вопрос" и вырежьте весь ненужный код - покажите нам только то, что имеет отношение к вашей проблеме.
2) прекратите использовать имена по умолчанию для вещей. Ваш код недокументирован, поэтому "Label1" до "Label26" и "Text1" до "Text19" включительно бесполезны для всех, кроме вас - и через три недели они будут бесполезны и для вас. Используйте собственные имена и помогите вашему коду стать более читабельным.
3) задавать вопросы - это навык: вы должны помнить, что человек, которого вы спрашиваете, не имеет контекста для вашего вопроса-он получает только то, что вы ему говорите. Поэтому мы понятия не имеем, что вы пробовали (и не собираемся пробираться через эту кучу мусора в поисках того, что это может быть) и с какими проблемами вы столкнулись, делая это!
Помогите нам помочь вам!