2008/5/31 MoDementia <[EMAIL PROTECTED]>: > I have spent most of the day searching for examples in VBscript to add / > update an image into a database without luck. > > If anyone has a snippet of code they could share I would be most grateful. > > I have either an image as an object in the script and or a physical file > location i.e. "C:\image.jpg" > > None of the examples I looked at even came close to helping me understand > what I need to do :(
Hi, in following VB code image file (or any other binary file) is read from disk to string, uuencoded, and can then be inserted into database. Another option is try to figure out dhSQLite http://www.thecommon.net/2.html . - Lauri Sub test_image_read_write() Dim path As String, filename As String Dim t1 As String, t2 As String Dim sql As String path = "C:\" filename = "image.jpg" t1 = loadfilename(path & filename) ' Do something here with t1, like insert into database... ' If insert statements don't like it, you can uuencode it t1 = uuencodetext(t1) ' If uuencoded text has ' in it, replace it with '' for sqlite insert t1 = Replace(t1, "'", "''") ' Now make sql string... sql = "INSERT INTO pics(filename, image) VALUES ('" & _ filename & "', '" & t1 & "');" MsgBox sql ' And execute it. ' And after reading it from database uudecode. t1 = uudecodetext(t1) savefilename t1, path & "test-" & filename t2 = loadfilename(path & "test-" & filename) If t1 = t2 Then t1 = "" t2 = "" Kill path & "test-" & filename MsgBox "Success!" Exit Sub Else t1 = "" t2 = "" Kill path & "test-" & filename MsgBox "Error: image modified when saved and loaded again!" Exit Sub End If End Sub Function loadfilename(filename As String) As String If Not FileExists(filename) Then loadfilename = "File does not exist!" Exit Function End If Dim t As Variant loadfilename = "" Dim iFreeFile As Integer Dim bytCount As Byte Dim data() As Byte iFreeFile = FreeFile Open filename For Binary As iFreeFile ReDim data(LOF(iFreeFile)) 'redim the array to take the whole file Get #iFreeFile, , data 'read the entire file into the byte array loadfilename = ByteArrayToString(data) Close iFreeFile End Function Sub savefilename(text As String, filename As String) Close If FileExists(filename) Then Kill filename Dim iFreeFile As Integer Dim bytCount As Byte Dim data() As Byte iFreeFile = FreeFile Open filename For Binary As iFreeFile data = StrConv(text, vbFromUnicode) Put #iFreeFile, , data 'read the entire file into the byte array Close iFreeFile End Sub Function uudecodetext(text As String) As String ' 1) Take away uudecode start text = Replace(text, "begin 644 data.dat" & vbLf, "") ' 2) Take away uudecode end text = Replace(text, vbLf & "end" & vbLf, "") ' 3) Do uudecode text = UUDecode(text) ' 4) Return result uudecodetext = text End Function Function uuencodetext(text As String) ' 1) UUEncode text text = UUEncode(text) ' 2) Add UUEncode beginning and end text = "begin 644 data.dat" & vbLf & text & vbLf & "end" & vbLf ' 3) Return result uuencodetext = text End Function Public Function ByteArrayToString(bytArray() As Byte) As String Dim sAns As String Dim iPos As String sAns = StrConv(bytArray, vbUnicode) iPos = InStr(sAns, Chr(0)) If iPos > 0 Then sAns = Left(sAns, iPos - 1) ByteArrayToString = sAns End Function Function FileExists(ByVal FileName As String) As Boolean On Error GoTo ErrorHandler ' get the attributes and ensure that it isn't a directory FileExists = (GetAttr(FileName) And vbDirectory) = 0 ErrorHandler: ' if an error occurs, this function returns False End Function Public Function UUEncode(sString As String) As String Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long For lTemp = 1 To 63 'Fill the translation table. bTrans(lTemp) = lTemp + 32 Next lTemp bTrans(0) = 96 'Replace spaces with 'graves' For lTemp = 0 To 255 'Fill the 2^8 and 2^16 lookup tables. lPowers8(lTemp) = lTemp * cl2Exp8 lPowers16(lTemp) = lTemp * cl2Exp16 Next lTemp iPad = Len(sString) Mod 3 'See if the length is divisible by 3 If iPad Then 'If not, figure out the odd bytes and resize the input. iPad = 3 - iPad sString = sString & String(iPad, Chr(0)) End If bIn = StrConv(sString, vbFromUnicode) 'Load the input string. lLen = ((UBound(bIn) + 1) \ 3) * 4 'Length of resulting string. lTemp = lLen \ 60 ReDim bOut((lTemp * 3) + lLen + 3) 'Make the output buffer with space for vbCrLfs and counts. lLen = 0 'Reusing this one, so reset it. lPos = 1 'Leave a space for the first line's count. For lChar = LBound(bIn) To UBound(bIn) Step 3 lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2) 'Combine the 3 bytes lTemp = lTrip And clOneMask 'Mask for the first 6 bits bOut(lPos) = bTrans(lTemp \ cl2Exp18) 'Shift it down to the low 6 bits and get the value lTemp = lTrip And clTwoMask 'Mask for the second set. bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12) 'Shift it down and translate. lTemp = lTrip And clThreeMask 'Mask for the third set. bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6) 'Shift it down and translate. bOut(lPos + 3) = bTrans(lTrip And clFourMask) 'Mask for the low set. If lLen = 56 Then 'Ready for a newline bOut(lPos + 4) = 13 'Chr(13) = vbCr bOut(lPos + 5) = 10 'Chr(10) = vbLf lLen = 0 'Reset the counter bOut(lPos - 57) = 77 'Insert the byte count for this line. lPos = lPos + 7 'Skip an extra position for the next line's count. Else lLen = lLen + 4 lPos = lPos + 4 End If Next lChar bOut(lPos) = 13 'Terminate the encoded data with a vbCrLF and `. bOut(lPos + 1) = 10 bOut(lPos + 2) = 96 bOut(lPos - (lLen + 1)) = ((lLen \ 4) * 3) - iPad + 32 'Calculate and add the byte count for the last line. UUEncode = StrConv(bOut, vbUnicode) 'Convert back to a string and return it. End Function Public Function UUDecode(sString As String) As String Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(64) As Long, lPowers12(64) As Long Dim lPowers18(64) As Long, lQuad As Long, iPad As Integer, lPos As Long, sOut As String Dim lTemp As Long, lLines As Long, lLast As Long, lLen As Long, lIndex As Long, lSkip As Long sString = Replace(sString, vbCr, vbNullString) 'Get rid of the vbCrLfs. sString = Replace(sString, vbLf, vbNullString) For lTemp = 32 To 127 'Fill the translation table. bTrans(lTemp) = lTemp - 32 Next lTemp bTrans(96) = 0 'The 'grave' character. For lTemp = 0 To 64 'Fill the 2^6, 2^12, and 2^18 lookup tables. lPowers6(lTemp) = lTemp * cl2Exp6 lPowers12(lTemp) = lTemp * cl2Exp12 lPowers18(lTemp) = lTemp * cl2Exp18 Next lTemp lLen = Len(sString) lLines = (lLen) \ 61 'Find the number of lines in the input. lLast = (lLen) Mod 61 'Find out how long the last line is. lTemp = (lLast) Mod 4 'Make sure the last line is comprised of quads. sString = sString & String(61 - lLast, Chr$(96)) bIn = StrConv(sString, vbFromUnicode) 'Load the input byte array. iPad = bIn(UBound(bIn) - (60)) - 32 'Number of last line bytes, as encoded at the line start. ReDim bOut((lLines + 1) * 45) 'Prepare the output buffer. (45 per 60 char line) lIndex = 1 'Skip the first byte--It's the first line byte count. Do Until lIndex > UBound(bIn) lSkip = lSkip + 1 If lSkip > 15 Then lIndex = lIndex + 1 'Skip the start of the next line. lSkip = 1 End If lQuad = lPowers18(bTrans(bIn(lIndex))) + lPowers12(bTrans(bIn(lIndex + 1))) + _ lPowers6(bTrans(bIn(lIndex + 2))) + bTrans(bIn(lIndex + 3)) 'Rebuild the bits. lTemp = lQuad And clHighMask 'Mask for the first byte bOut(lPos) = lTemp \ cl2Exp16 'Shift it down lTemp = lQuad And clMidMask 'Mask for the second byte bOut(lPos + 1) = lTemp \ cl2Exp8 'Shift it down bOut(lPos + 2) = lQuad And clLowMask 'Mask for the third byte lPos = lPos + 3 lIndex = lIndex + 4 Loop sOut = StrConv(bOut, vbUnicode) 'Convert back to a string. sOut = Left$(sOut, ((lLines) * 45) + iPad) 'Chop off any extra bytes. UUDecode = sOut End Function Public Function Replace(ByVal sIn As String, ByVal sFind As _ String, ByVal sReplace As String, Optional nStart As _ Long = 1, Optional nCount As Long = -1, _ Optional bCompare As VbCompareMethod = vbBinaryCompare) As _ String Dim nC As Long, nPos As Long Dim nFindLen As Long, nReplaceLen As Long nFindLen = Len(sFind) nReplaceLen = Len(sReplace) If (sFind <> "") And (sFind <> sReplace) Then nPos = InStr(nStart, sIn, sFind, bCompare) Do While nPos nC = nC + 1 sIn = Left(sIn, nPos - 1) & sReplace & _ Mid(sIn, nPos + nFindLen) If nCount <> -1 And nC >= nCount Then Exit Do nPos = InStr(nPos + nReplaceLen, sIn, sFind, _ bCompare) Loop End If Replace = sIn End Function _______________________________________________ sqlite-users mailing list sqlite-users@sqlite.org http://sqlite.org:8080/cgi-bin/mailman/listinfo/sqlite-users
