Convertir rapidement un fichier uploadé (image) et obtenir les valeurs des clefs (convertbin2ascii)

Commenter

Contenu du snippet

Bonjour TLM...
Voilà un petit bout de code qui permet de retrouver les valeurs des clefs dans une variable de type binaire qui aurait été initialisée par exemple:

MyBinData=Request.BinaryRead(Request.TotalBytes)

Ensuite la function GetKeyVal te permet d'extraire les valeurs, pratique lorsque l'on pousse une image et que l'on a posté d'autres valeurs, comme un commentaire, ou une date.

Pourquoi pratique? Le fait d'utiliser Request.BinaryRead empêchera ensuite toute utilisation de Request.Form et vice et versa...

Source / Exemple : 


function ConvertBin2Ascii(BinData)
    'On Error Resume Next
    Dim MonObjRs
    Set MonObjRs = CreateObject("ADODB.Recordset")
    MonObjRs.Fields.Append "TmpBin", 201, lenB(BinData)
    MonObjRs.Open
    MonObjRs.AddNew
    MonObjRs("TmpBin").AppendChunk BinData
    MonObjRs.Update
    ConvertBin2Ascii= MonObjRs("TmpBin")
    MonObjRs.Close
    Set MonObjRs = Nothing
  End function

  Function GetKeyVal(Key,Default,MyAsciiData)
    HeaderCode=left(MyAsciiData,instr(1,MyAsciiData,vbcrlf,0)-1)
    If InStr(1, MyAsciiData, "name=""" & Key & """", 0)>0 Then
      pos=InStr(1, MyAsciiData, "name=""" & Key & """", 0)+Len("name=""" & Key & """")+4
      getKeyVal=Mid(MyAsciiData,pos,InStr(pos-1,MyAsciiData, HeaderCode,0)-pos-2)
    Else
      getKeyVal=Default
    End If
  End Function

  Function GetFileName(AsciiData)
    pos = InStr(1, AsciiData, "filename=", 0) + 10
    begin = pos
    DO
      theChar = Mid(AsciiData,pos,1)
      IF theChar = """" THEN EXIT DO
      IF theChar = "/" OR theChar = "\" THEN begin = pos+1
      pos = pos + 1
    LOOP
    GetFileName = Mid(AsciiData, begin, pos-begin)
  End Function

  Function GetImageData(AsciiData)
    firstReturnPos = InStr(1,AsciiData,vbCrLf,0)
    doubleReturnPosition = InStr(InStr(1,AsciiData,"filename=",0),AsciiData, vbCrLf & vbCrLf,0)
  
    FileSize = Len(AsciiData) - doubleReturnPosition -  firstReturnPos - 8
    GetImageData = Mid(AsciiData, doubleReturnPosition+4, FileSize)
  End Function

Conclusion :


Juste une précision il est important et nécessaire que l'image proprement dite soit en dernière position lors du postage du form sinon le code retrouvera pas les données de l'image.

On peut s'amuser à imbriquer le tout comme suit:

'Initialise la variable
MyAsciiData=ConvertBin2Ascii(Request.BinaryRead(Request.TotalBytes))

'Obtenir les autres clefs
pSubject = (GetKeyVal("Subject","MaValeurParDefaut",MyAsciiData))
pAuthor = (GetKeyVal("Author","",MaValeurParDefaut,MyAsciiData))
pComments = (GetKeyVal("Comments","",MaValeurParDefaut,MyAsciiData))

'Sauver l'image
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Set file = fs.CreateTextFile(Server.MapPath(".") & "\MonSousRepertoireSurLeServeur\" & GetFileName(MyAsciiData), false)
file.write GetImageData(MyAsciiData)
file.close

Set file = Nothing
Set fs = Nothing


Vouala c'est tout ! Une bonne partie viens de ce site, mais je remarque encore que des programmeurs mettent des exemples de conversion de bin to ascii fait avec une boucle, affreusement lent et au dessus de 150ko on passe gentiment à un processus qui dure plus d'une minute..;-(

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.