Gif2Hex

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Gif2Hex

Logged in as: Guest

arrSession:exec spGetSession 2,16,53444

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Gif2Hex
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Gif2Hex - 11/11/2007 11:46:11 PM

Meg

Posts: 123
Score: 2
Joined: 7/13/2006
From: Australia
Status: offline

Convert a GIF to Hex to VBS code for turning it back into a GIF again.

Create a new file on your computer called GIF2HEX.HTA and paste the attached code into it.

Run GIF2HEX.HTA

Usage instructions are displayed in Program.

<html> 
<head> 
<title>Gif2Hex</title> 
<HTA:APPLICATION 
    ID="objGif2Hex" 
    APPLICATIONNAME="Gif2Hex" 
    SCROLL="no" 
    navigable="no" 
    selection="no" 
    showintaskbar="yes" 
    singleinstance="no" 
    innerborder="no" 
    maximizebutton="no" 
    minimizebutton="yes" 
    border="dialog" 
    borderstyle="normal" 
    caption="yes" 
    contextMenu="no" 
    sysmenu="yes" 
> 
<style> 
body,td,a {font-family:Tahoma, Veranda, Arial; font-size:12px; text-decoration:none; color:black;} 
a:link { color : blue; background : transparent ;   text-decoration: underline} 
a:visited { color : black; background : transparent ;   text-decoration: none} 
a:Hover { color : red; background : transparent ;   text-decoration: none} 
</style> 
</head>

<SCRIPT LANGUAGE="VBScript"> 
'-------------------------------------------------------------------------------- 
Sub Window_Onload 
  window.resizeto 750,400 
       SplashOut.Style.Display = "none" 
       iTimerID = window.setInterval("ShowSplash", 5000) 
  txtNotes.value = "1. Convert a GIF to Hex to VBS code for turning it back into a GIF again."&vbcrlf&"2. Example button will display an image of a star encoded already in this script. "&vbcrlf&"3. Actually seems to work with all binary file types I have tested, rename ext. "&vbcrlf&"4. Click 'By MJP 2007' on the splash screen to contact me. " 
End Sub 
'-------------------------------------------------------------------------------- 
Sub ShowSplash 
       Splash.Style.Display = "None" 
       Main.Style.Display = "Inline" 
  SplashOut.Style.Display = "none" 
End Sub

'-------------------------------------------------------------------------------- 
Function cmdEncode 
Const ForReading = 1, ForWriting = 2, ForAppending = 8 
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 
Dim fso, f, Msg 
Set fso = CreateObject("Scripting.FileSystemObject") 
vCancel = false 
if not fso.fileexists(txtFile.value) then 
  vCancel = true 
else 
  Set f = fso.getfile(txtFile.value) 
  if f.size > 100*1024 then 
     if msgbox("The file is quite big, the process may last some minutes and the application may seem to hang." & vbCrLf & "continue?",vbYesNo+vbDefaultButton2)=vbNo then vCancel = true 
  end if 
end if 
if not vCancel = true then 
  Set f = fso.OpenTextFile(txtFile.value, ForReading) 
  if txtFileOut.value = "" then 
     vFileOut = txtFile.value & ".vbs" 
  else 
     vFileOut = txtFileOut.value 
  end if 
  Set f2 = fso.OpenTextFile(vFileOut, ForWriting, True) 
  txtNotes.value = txtNotes.value & vbCrLf & txtFile.value & " -> " & vFileOut 
   
     LineLength = 0 
     f2.writeline "On Error Resume Next" 
     f2.writeline "Set ts = CreateObject(""Scripting.FileSystemObject"").OpenTextFile(""" & vFileOut & ".gif"", 2, True)" 
     f2.write "For x = 1 To 511 Step 2 : ts.Write Chr(Clng(""&H"" & Mid(""" 
      
     Do While Not f.AtEndOfStream 
        myByte = hex(asc(f.Read(1))) 
     if len(myByte) = 1 then myByte = "0" & myByte 
        vCount2 = vCount2 +1 
           f2.write myByte 
         
         
        if vCount2 mod 256 = 0 then 
           f2.writeline """,x,2))) : Next" 
           f2.write "For x = 1 To 511 Step 2 : ts.Write Chr(Clng(""&H"" & Mid(""" 
        end if 
     Loop 
      
     f2.writeline """,x,2))) : Next" 
     f2.writeline "ts.Close" 
   
  f.close 
  f2.close 
  txtNotes.value = txtNotes.value & vbCrLf & "Encode completed." 
  msgbox "Encode completed." 
end if 
end Function 
'-------------------------------------------------------------------------------- 
sub Example 
On Error Resume Next 
Set ts = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\star.gif", 2, True) 
For x = 1 To 511 Step 2 : ts.Write Chr(Clng("&H" & Mid("47494638396129002900C40000FFC5C5FF3535FF2C2CFF4B4BFF6161FF3E3EFFB6B6FF7777FFFCFCFFEAEAFF6969FFA8A8FFABABFF9090FF5A5AFF9696FFEDEDFF2121FF6F6FFF1212FF8787FFF3F3FFF6F6FF4E4EFF9393FFF9F9FFDADAFF4242FFA5A5FF6666FF0000FFFFFF21F90400000000002C00000000290029000005FFE0278E64699E68AAAE6CAB1A6EBC16726D6A9E66B77AF9788FDBAE2459942E9E4B69211992181ECC0831F14C10238C87E11C253C9E830800F600440770A23B12803B084A9982208005EC91A23C08940303650A79220B6587881E46845F89896B841F6E8E6578430D1D999A119465119A9A0D2E107E9DA67F10311505A7A605",x,2))) : Next 
For x = 1 To 511 Step 2 : ts.Write Chr(Clng("&H" & Mid("15351681AD8903163B190EB4870E195D1DBB1E706C7BBB834E08BAC11E0E58361648CB6017B732151BD2871BB0A3A5D9A82E18A0999CA69FE3A243939D968CB4907950AD8B79C51E7D7FB31EC7799304717332D8F1D0AE4B23311FC88039F3218D07784EA0A4FB40C58AB30F0DB6E491C0A144A00125383461D383C48F20254A1346128143E54A14345EAE8021B3A6CD9B4E4200003B",x,2))) : Next 
ts.Close 
On error goto 0 
SplashOut.Style.Display = "inline" 
Main.Style.Display = "none" 
SampleImg.innerhtml="Building File From Hex Data in Script" 
sleep 2 
SplashOut.Style.Display = "inline" 
Main.Style.Display = "none" 
SampleImg.innerhtml="<img src='C:\star.gif'><br>c:\star.gif" 
iTimerID = window.setInterval("ShowSplash", 5000) 
txtNotes.value = "You were just shown a GIF image of a star, built from hex data in this script. "&vbcrlf&"File is c:\star.gif if you wish to examine or delete it." 
end sub 
'-------------------------------------------------------------------------------- 
Sub Sleep(strSeconds) 
  strCmd = "%COMSPEC% /c ping -n " & strSeconds & " 127.0.0.1>nul" 
  Set objShell=CreateObject("Wscript.shell") 
  objShell.Run strCmd,0,1 
End Sub 
'-------------------------------------------------------------------------------- 
</SCRIPT>

<body> 
<DIV id="Splash" STYLE="Background-color:white;Height:200;Width:400;Border:0.1mm solid black;position:relative;top:60;left:175;font:14pt arial;"> 
<br><br> 
<center> 
  <font face="arial" color=RED size=5><b><i> Gif2Hex </i></b></font> 
  <br> 
  <a href="http://www.painterinfo.com/php2bb/viewtopic.php?t=517">By MJP 2007</a> 
  <br><br> 
  Convert your GIF to Hex to VBS code  
</center> 
</DIV>

<DIV id="SplashOut" STYLE="Background-color:white;Height:200;Width:400;Border:0.1mm solid black;position:relative;top:60;left:175;font:14pt arial;"> 
<br><br> 
<center> 
<span id=SampleImg>Image Generated</span> 
</center> 
</DIV>

<DIV id="Main" STYLE="display:none;position:absolute"> 
<br><br><br> 
<table width="100%" > 
 <tr> 
   <td width="50%" valign="top"> 
  Input: <font color=silver>gif extention</font> 
  <br> 
  <input name="txtFile" type="file" id="txtFile"> 
  <BR><BR> 
  Output: <font color=silver>vbs extention</font> 
  <br> 
  <input name="txtFileOut" type="file" id="txtFileOut"> 
   </td> 
   <td width="50%" valign="center"> 
  <font face="arial" color=RED size=5><b> Gif2Hex </b></font> 
  <input id=runbutton1 class="button" type="button" value="Encode" name="cmdEncode" onClick="cmdEncode"> 
  <input id=runbutton2 class="button" type="button" value="Example" name="Example" onClick="Example"> 
   </td> 
 </tr> 
</table> 
<br><BR> 
Messages: 
<br><br> 
<textarea name="txtNotes" cols="86" rows="6" ></textarea> 
</DIV> 
</body> 
</html>

< Message edited by Meg -- 12/27/2007 8:45:27 AM >