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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 983 fois - Téléchargée 29 fois

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

Ajouter un commentaire

Commentaires

arcade205
Messages postés
3
Date d'inscription
vendredi 13 janvier 2006
Statut
Membre
Dernière intervention
9 juillet 2007
-
Bonjour à tous,

Je me suis permis de modifier la fonction GetKeyVal() car il lui manquait un p'ti quelque chose ...

En fait, comment fait'on si on a plusieurs valeurs pour la même Key ??? On boucle ;-)
Me direz vous, c'est idiot d'avoir plusieurs input dans un formulaire ayant le même nom ?!
Eh bien, je ne parle pas de ce cas mais si vous utilisez un liste à choix multiple, vous serez bien embêté de récupérer que la 1ère valeur ...

Donc j'ai juste ajouté une boucle & quelques commentaires :

Function GetKeyVal(psKey, psDefault, psMyAsciiData)
Dim lsRet : lsRet = ""
Dim lsMyAsciiData : lsMyAsciiData = psMyAsciiData
Dim lsHeaderCode : lsHeaderCode = Left(lsMyAsciiData, InStr(1, lsMyAsciiData, vbcrlf, 0) - 1)
Dim liPos : liPos = 0
Dim liBegin : liBegin = 0
Dim liCutData : liCutData = 0
Dim lbGo : lbGo = False

'On parcourt récursivevement lsMyAsciiData
Do While Not lbGo
liBegin = InStr(1, lsMyAsciiData, "name=""" & psKey & """", 0) 'On recherche notre Key

If liBegin > 0 Then 'Si on trouve notre Key
liPos = liBegin + Len("name=""" & psKey & """") + 4 'Position de début

liCutData = InStr(liPos - 1, lsMyAsciiData, lsHeaderCode, 0) - liPos - 2 'On récupère la taille de la valeur de notre Key

lsRet = lsRet & Mid(lsMyAsciiData, liPos, liCutData) & ", " 'On extrait la valeur de Key

lsMyAsciiData = Right(lsMyAsciiData, Len(lsMyAsciiData) - (liPos + liCutData)) 'On supprime la 1ère valeur de notre Key
Else
lbGo = True 'Sinon on sort de la boucle
End If
Loop

'On supprime le dernier ', ' sinon on renvoie la valeur par défault
If lsRet <> "" Then lsRet Left(lsRet, Len(lsRet) - 2) Else lsRet psDefault

GetKeyVal = lsRet
End Function

& encore merci à ObelixSuisse pour cette fonction de base.
arcade205
Messages postés
3
Date d'inscription
vendredi 13 janvier 2006
Statut
Membre
Dernière intervention
9 juillet 2007
-
Bonjour,

un grand merci pour ta source, les fonctions ConvertBin2Ascii() & GetKeyVal() me sont utiles à merveille !

Aligato.
AliBabNet
Messages postés
2
Date d'inscription
mardi 13 septembre 2005
Statut
Membre
Dernière intervention
7 juin 2006
-
Impeccable!

Bravo et merci Obelix, c'est le seul code valable et efficace que j'aie trouvé pour récupérer un upload + des champs de formulaire.

Avis aux visiteurs: foncez, c'est du bon! ;)
ObelixSuisse
Messages postés
15
Date d'inscription
lundi 9 mai 2005
Statut
Membre
Dernière intervention
26 mai 2010
-
Salut Alain...
Merci je n'avais pas vu cette option ;-)
cs_Alain Proviste
Messages postés
910
Date d'inscription
jeudi 26 juillet 2001
Statut
Modérateur
Dernière intervention
1 février 2015
1 -
sais tu que tu peux éditer ton code ?
:)

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.