home *** CD-ROM | disk | FTP | other *** search
Attribute VB_Name = "vb32_CGI" '------------ VB4_Upload_CGI (32 Bit) ------------ ' ' This program has been tested with Netscape Enterprise Server for NT. ' ' Written by Kent Empie (kempie@chesco.com, kempie@usa.net, http://www.chesco.com/~kempie) ' ' Special thanks to: ' Paul Stohr (http://www.prplus.com) for his tips on using the Win32API ' to communicate with standard in/out as well as a couple of the CGI subs. ' ' Premier Solutions Ltd. (http://www.premierltd.com) for allowing me to ' publish code that was partially developed while under their employment. ' ' Note: Sub Main() is the "startup form" for this program. '---------------------------------------------------------------------- Option Explicit Global Const csUploadDir = "http_uploads" Global gsOutputFileName As String Global gsOutputFilePath As String Global glOutputFileLen As Long 'Declare the needed Win32 API functions Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal bsName As String, ByVal buff As String, ByVal ch As Long) As Long Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long 'Constants necessary for the Win32 API functions ReadFile and WriteFile Public Const STD_INPUT_HANDLE = -10& Public Const STD_OUTPUT_HANDLE = -11& 'This list matches Netscape Enterprise Server. Your Server's CGI 'environment variables may differ slightly. Global CGI_Server_Software As String Global CGI_Server_Name As String Global CGI_Server_URL As String Global CGI_Gateway_Interface As String Global CGI_Server_Protocol As String Global CGI_Server_Port As String Global CGI_Request_Method As String Global CGI_Path_Info As String Global CGI_Path_Translated As String Global CGI_Script_Name As String Global CGI_Query_String As String Global CGI_Remote_Host As String Global CGI_Remote_Addr As String Global CGI_Referer As String Global CGI_Auth_Type As String Global CGI_Remote_User As String Global CGI_Content_Type As String Global CGI_Content_Length As String Global CGI_HTTPS As String Global CGI_HTTPS_Key_Size As String Global CGI_HTTPS_Secret_Key_Size As String Global CGI_HTTP_Accept As String Global CGI_User_Agent As String Global CGI_If_Modified_Since As String Global CGI_HTTP_From As String Global CGI_Version As String Global CGIname As String Global glStdIn As Long Global gsBuff As String Global glBytesRead As Long Global glResult As Long Global gsStandardIn As String Sub DownloadFile() ' 'Download the file to demonstrate that it was uploaded properly. ' 'The CGI_Query_String will be in the following format: ' "download:filename" ' 'This sub will open the file for output and send it to the browser 'as an octet stream. ' Dim sFileName As String sFileName = Right$(CGI_Query_String, Len(CGI_Query_String) - InStr(CGI_Query_String, ":")) 'Check for the existence of the file to download. Dim lFileNumber, lBufSize As Long Dim sBuffer As String sFileName = csUploadDir & "\" & sFileName If Dir$(sFileName) = "" Then SendHeader ("Error") Send "Error: file " & sFileName & " was not found." WriteLogFile "Error: <b>" & sFileName & "</b> was not found." SendFooter End End If 'Get the file size in bytes lBufSize = FileLen(sFileName) 'Open the file. lFileNumber = FreeFile ' Get unused file number. Open sFileName For Binary Access Read As #lFileNumber Send ("Content-type: application/octet-stream " & vbCrLf) WriteLogFile "Began to download file " & sFileName 'Do While Not EOF(lFileNumber) ' Loop until end of file. sBuffer = Input(lBufSize, #lFileNumber) 'Get next 1024 characters. Send sBuffer 'Send to the client browser. 'Loop Close #lFileNumber WriteLogFile "Finished download: " & sFileName End End Sub Sub ErrorHandler() SendHeader "<TITLE>Error in " & CGI_Script_Name & "</TITLE>" Send "<H1>Error in " & CGI_Script_Name & "</H1>" Send "An internal Visual Basic error <b>(" & Error & ")</b> has occurred in " & CGI_Script_Name & ".<br><br>" Send "Data posted to Standard in: <br><hr>" & gsStandardIn & "<br><hr>" Send "</BODY></HTML>" WriteLogFile "***Error: " & Error End 'Terminate the program End Sub Function WriteLogFile(argString) As Boolean Dim sFileName As String Dim sFileNumber As Long sFileName = "upload_cgi.log" sFileNumber = FreeFile ' Get unused file number. If Dir$(sFileName) = "" Then Open sFileName For Output As #sFileNumber ' Create file. Else Open sFileName For Append As #sFileNumber ' Append to file. End If Print #sFileNumber, Format(Now, "YYYYMMDD hh:mm:ss AMPM") & _ ", CGI_Remote_Addr: " & CGI_Remote_Addr & _ ", " & argString Close #sFileNumber End Function '========================================= ' Get CGI data for a Name used in the form '========================================= ' ' Data is stored in the gsStandardIn as "name=value&name=value&..." ' The "name" = the value given to it in the form ' Ex: <INPUT NAME="uname" SIZE=30> ' "uname" is the NAME that would be used to obtain the value assigned ' to it when the form was submitted ' Function GetCGIvalue(CGIname As String) As String Dim CGIvalue As String 'Temporary place holder Dim valuepos, eqPos, amPos As Long valuepos = InStr(1, gsStandardIn, CGIname + "=", 1) 'Use 1 for a case INSENSITIVE search If valuepos = 0 Then 'What if the name is not found... 'This only happens for check boxes if they aren't filled in. GetCGIvalue = "CGIName Not Found" Else 'Get the data between the "=" and the next "&" eqPos = InStr(valuepos, gsStandardIn, "=") amPos = InStr(eqPos, gsStandardIn, "&") If amPos = 0 Then amPos = Len(gsStandardIn) + 1 'Must be the last value in the STDIN If amPos - eqPos = 1 Then 'Now what if they didn't enter any input ? GetCGIvalue = "" Else 'Now lets grab what's between the "=" and the "&" CGIvalue = Mid$(gsStandardIn, eqPos + 1, amPos - eqPos - 1) 'Lets decode the data (only if needed) 'URL encoded data contains "+" for spaces and replaces "?%+" characters that 'the user may have entered into "%<hex value>" Example: Line feed with return ="%0A%0D" If InStr(CGIvalue, "+") Then CGIvalue = ReplaceTxt(CGIvalue, "+", " ") If InStr(CGIvalue, "%") Then CGIvalue = ReplaceTxt(CGIvalue, "%", "HEX") GetCGIvalue = CGIvalue End If End If End Function ' Get CGI Enviroment Variables ' Function GetCGIenvVar(CGIvariable As String) As String gsBuff = String(1024, 0) glResult = GetEnvironmentVariable(CGIvariable, gsBuff, 1024) 'glResult returns the length of the value If glResult Then GetCGIenvVar = Left(gsBuff, glResult) 'trim string to the length of the actual data Exit Function End If GetCGIenvVar = "Not available" End Function Sub GetStandardInData() 'Get the handle for Standard In glStdIn = GetStdHandle(STD_INPUT_HANDLE) 'Get posted CGI data from STDIN Do gsBuff = String(1024, 0) ' Create a buffer big enough to hold the 1024 bytes glBytesRead = 1024 ' Tell it we want at least 1024 bytes If ReadFile(glStdIn, ByVal gsBuff, 1024, glBytesRead, ByVal 0&) Then 'Read the data ' Add the data to our string gsStandardIn = gsStandardIn & Left(gsBuff, glBytesRead) If Len(gsStandardIn) = CGI_Content_Length Then Exit Do 'All data has been received--Exit out of loop completely. End If End If Loop End Sub '=========================================================== ' Get the Enviroment variables we will use with this program '=========================================================== ' Original Code by Paul Stohr (www.prplus.com) ' ' Modified 4-11-96 by Kent Empie to match Netscape Commerce Server ' version 1.13 exactly. ' ' When finished testing--comment out the ones that are not used to ' optimize for speed. ' Sub InitCGIVariables() CGI_Server_Software = GetCGIenvVar("SERVER_SOFTWARE") CGI_Server_Name = GetCGIenvVar("SERVER_NAME") CGI_Server_URL = GetCGIenvVar("SERVER_URL") CGI_Gateway_Interface = GetCGIenvVar("GATEWAY_INTERFACE") CGI_Server_Protocol = GetCGIenvVar("SERVER_PROTOCOL") CGI_Server_Port = GetCGIenvVar("SERVER_PORT") CGI_Request_Method = GetCGIenvVar("REQUEST_METHOD") CGI_Path_Info = GetCGIenvVar("PATH_INFO") CGI_Path_Translated = GetCGIenvVar("PATH_TRANSLATED") CGI_Script_Name = GetCGIenvVar("SCRIPT_NAME") CGI_Query_String = GetCGIenvVar("QUERY_STRING") CGI_Remote_Host = GetCGIenvVar("REMOTE_HOST") CGI_Remote_Addr = GetCGIenvVar("REMOTE_ADDR") CGI_Referer = GetCGIenvVar("HTTP_REFERER") CGI_Auth_Type = GetCGIenvVar("AUTH_TYPE") CGI_Remote_User = GetCGIenvVar("REMOTE_USER") CGI_HTTPS = GetCGIenvVar("HTTPS") CGI_HTTPS_Key_Size = GetCGIenvVar("HTTPS_KEYSIZE") CGI_HTTPS_Secret_Key_Size = GetCGIenvVar("HTTPS_SECRETKEYSIZE") CGI_HTTP_Accept = GetCGIenvVar("HTTP_ACCEPT") CGI_User_Agent = GetCGIenvVar("HTTP_USER_AGENT") CGI_If_Modified_Since = GetCGIenvVar("HTTP_IF_MODIFIED_SINCE") CGI_HTTP_From = GetCGIenvVar("HTTP_FROM") CGI_Content_Type = GetCGIenvVar("CONTENT_TYPE") CGI_Content_Length = GetCGIenvVar("CONTENT_LENGTH") End Sub Sub SendSuccessMessage() 'This file upload confirmation can say just about anything. 'It is helpful to send some sort of a success message, as 'well as the file name and size in bytes. ' 'In this case, we will also send back a directory list of all 'files that were uploaded to the "http_uploads" directory. Dim sTempFileName As String Dim lTempCount As Long Send "<h1>File Upload was Successful.</h1>" Send "<blockquote>" Send "<br>" Send "<b>File Received: <i>" & gsOutputFileName & "</i>" Send "Size: <i>" & Format(glOutputFileLen, "###,###,###") & " bytes</i></b><br>" Send "<b>Submitted By: <i>" & CGI_Remote_User & "</i></b><br>" Send "<br>" Send "<br>" Send "</blockquote>" Send "The following is a list of files that has been uploaded to the Web server. " Send "You can click on the file names to download them.<br><br>" 'Go through the uploads directory and echo each file back to the user. Send "<table>" Send "<tr><td></td><td>" Send "<b>File Name</b>" Send "</td><td>" Send "<b>File Size</b>" Send "</td><td>" Send "<b>File Date & Time</b>" Send "</td></tr>" sTempFileName = Dir(csUploadDir & "\*.*") Do While sTempFileName <> "" lTempCount = lTempCount + 1 Send "<tr><td>" & lTempCount & ".</td><td>" Send "<a href=" & CGI_Script_Name & "/" & sTempFileName & "?download:" & sTempFileName & ">" Send sTempFileName Send "</td><td>" Send Format(FileLen(csUploadDir & "/" & sTempFileName), "###,###,###") & " bytes.</a>" Send "</td><td>" Send FileDateTime(csUploadDir & "/" & sTempFileName) Send "</td></tr>" sTempFileName = Dir Loop Send "</table>" End Sub Sub SendUploadForm() 'Send the Upload form to the user. This is the form that includes the now 'official HTML 3.2 form field, "<input type=file>" and the multipart encoding. SendHeader ("HTTP Upload Demo") Send ("<h2>Please Select a file to upload.</h1>") Send "<FORM ENCTYPE=multipart/form-data ACTION=" & CGI_Script_Name & " METHOD=POST>" Send "<FONT SIZE = +1>Directions:</font>" Send "<ul>" Send "<li>Type in the full path name of the file to upload." Send "<li>-or- Hit the [Browse] button to find the file on your computer." Send "<li>Then hit the [Upload] button." Send "</ul>" Send "<blockquote>" Send "<table border=10 bgcolor=#CCCCCC><tr><td><br>" Send "<b>File Name...</b><br>" Send "<INPUT NAME=userfile SIZE=30 TYPE=file><br>" Send "<br>" Send "<center>" Send "<input type=""submit"" value=""Upload File"">" Send "</center><br>" Send "</td></tr></table>" Send "</blockquote>" Send "<i><b>Note:</b> Please be patient with large files...You will " Send "not receive any notification until the file is completely transferred.<br>" Send "<br>" Send "</form>" SendFooter End Sub Sub Main() 'General VB4 CGI information: 'This Sub Main() is defined as the Startup Form (found in the menu under 'Tools, Options, Project) All debugging can be done by writing to log files, 'or by using MsgBoxes if your console programs in NT have access to interact 'with the desktop. 'About this Upload CGI program: 'This program implements an RFC 1867 HTTP file upload. ' 'If called with a GET method, it sends a form to be filled out. 'This form includes the name of a file that is on the user's computer. 'The user can then select a local file from an open file dialogue box. 'When the use hits the submit button on the form, the file is sent 'to this program using the POST method. This program then reads the 'posted data from standard in into the global variable 'gsStandardIn', parses 'out the file name and the body of the file by searching for MIME 'multipart boundaries. Once the beginning and ending boundaries are 'located, the program writes the file as a binary file to a temporary 'directory. ' 'Security Notice: 'The uploaded files should not be placed in a CGI directory, or in a 'Public HTTP directory without first doing a security assessment. ' 'Obviously, some type of user authentication should be performed before 'allowing anyone to upload files to your server. On Error GoTo CallErrorHandler 'Intialize and get the enviroment variables first. InitCGIVariables 'Assuming authentication is turned on, this is where you 'should add in some checking for user permissions. 'If the program is called with the GET method and there is no query 'string, send back the upload form. The upload form can be a plain HTML 'file--it does not have to be sent by this program. If CGI_Request_Method = "GET" Then Select Case CGI_Query_String Case "Not available" SendUploadForm Case Else DownloadFile 'Download the file that is named in the CGI_Query_String. End Select End End If SendHeader ("File Upload Example") 'Get the posted data from standard in, and load it into the gsStandardIn string GetStandardInData gsOutputFilePath = GetMultipartFormData("filename=") If Trim(gsOutputFilePath) = "" Then Send ("<hr>") Send ("<h2>Error -- No file name entered.</h2><br>") Send ("Hit the BACK button and select a valid file name.<br>") Send ("<hr>") End End If 'Strip off the path from the file. gsOutputFileName = StripOffPath(gsOutputFilePath) ' Parse out the Uploaded file by its multipart MIME headers Dim sContentHeaderID, sEndContentHeaderID As String Dim lStartPos As Long Dim lStartFilePos, lEndFilePos As Long 'The determined positions of the 'beginning and end of the file. If lStartPos = 0 Then sContentHeaderID = Right$(CGI_Content_Type, Len(CGI_Content_Type) - (InStr(1, CGI_Content_Type, "boundary=") + 10)) sEndContentHeaderID = sContentHeaderID & "--" 'Get the significant positions of the uploaded file. lStartPos = InStr(1, gsStandardIn, "filename=") 'The browser may or may not put a "Content-Type:" string after the file 'name but before the actual start of the file. This depends on whether 'the file type is registered with the browser. If it's there, find the 'first carriage return after it to locate the beginning of the file. 'Otherwise, the beginning of the file is after the filename="<file>". If InStr(gsStandardIn, "Content-Type:") > 0 Then lStartFilePos = InStr(InStr(lStartPos, gsStandardIn, "Content-Type:"), gsStandardIn, Chr$(13)) If lStartFilePos <= 0 Then Error "Error locating starting file position." End If Else lStartFilePos = InStr(InStr(lStartPos, gsStandardIn, "filename="), gsStandardIn, Chr$(13)) If lStartFilePos <= 0 Then Error "Error locating starting file position." End If End If lStartFilePos = lStartFilePos + 4 'Advance the start position four characters past the last chr$(13). 'Uncomment the following for testing 'Send "lStartFilePos: " & lStartFilePos & "<br>" 'Dim x As Long 'For x = 1 To 170 ' Send x & ": <font color=#FF0000>" & Mid$(gsStandardIn, x, 1) & "</font> " 'Next x 'Send "<br>" lEndFilePos = InStr(lStartFilePos, gsStandardIn, sContentHeaderID) If lEndFilePos = 0 Then 'No end in sight! Send "<BR><BR><H2>No ending boundary found!</h2>" Send "Last characters of gsStandardIn: " & Right$(gsStandardIn, 60) & "<br>" Send "<br>Len(gsStandardIn): " & Len(gsStandardIn) Send "<br>sContentHeaderID: " & sContentHeaderID Send "<br>lStartPos: " & lStartPos Send "<br>lStartFilePos: " & lStartFilePos Send ("<hr>") SendTestCGIInfo Send ("gsStandardIn: " & gsStandardIn) SendFooter End Else lEndFilePos = lEndFilePos - 6 End If glOutputFileLen = lEndFilePos - lStartFilePos End If 'Give error message if there was no file uploaded. If glOutputFileLen = 0 Then Send ("<hr>") Send ("<h2>Error -- File not uploaded.</h2><br>") Send ("Hit the BACK button and select a valid file name.<br>") Send ("<hr>") End End If Dim sOutput As String sOutput = Mid$(gsStandardIn, lStartFilePos, glOutputFileLen) 'Save the file to disk. Dim lBytesWritten, lFileHandle, lNumberOfBytesToWrite, glResult As Long Dim sBuffer As String Dim lFileNum As Long lFileNum = FreeFile 'Check to see that the http_uploads directory is there, and then save the file there. If Dir$(csUploadDir, vbDirectory) = "" Then 'Is the uploads directory there? MkDir csUploadDir End If gsOutputFileName = csUploadDir & "\" & LCase(gsOutputFileName) WriteLogFile "User " & CGI_Remote_User & " uploaded " & gsOutputFileName & " " & glOutputFileLen & " bytes." If Dir$(gsOutputFileName) <> "" Then Kill gsOutputFileName 'Always overwrite the file for this demonstration. End If Open gsOutputFileName For Binary As #lFileNum Put #lFileNum, 1, sOutput Close #lFileNum SendSuccessMessage SendTestCGIInfo ' echo back the environment variables for this demo SendFooter End 'Terminate the CGI program. CallErrorHandler: Send "<br>lStartFilePos: " & lStartFilePos Send "<br>lEndFilePos: " & lEndFilePos Send "<br>gloutputFileLen: " & glOutputFileLen Send "<br>sOutput: " & Left$(sOutput, 40) & "...<br>" Send "<br>gsOutputFileName: " & gsOutputFileName & "<br>" Send "<br>sContentHeaderID: " & sContentHeaderID & "<br>" Call ErrorHandler End Sub Function GetMultipartFormData(argFieldName) As String ' Extract the uploaded file name from the MIME encoded string ' Dim lStartFileNamePos, lFileNameLength As Long On Error GoTo Error_Handler lStartFileNamePos = InStr(gsStandardIn, argFieldName) + Len(argFieldName) + 1 If lStartFileNamePos = 0 Then GetMultipartFormData = "" Exit Function End If lFileNameLength = InStr(lStartFileNamePos + 1, gsStandardIn, """") - lStartFileNamePos If lFileNameLength = 0 Then GetMultipartFormData = "" Exit Function End If GetMultipartFormData = Mid$(gsStandardIn, lStartFileNamePos, lFileNameLength) Exit Function Error_Handler: WriteLogFile "Error in GetMultipartFormData: " & Error GetMultipartFormData = "" End Function Function StripOffPath(argFileName) As String 'Locate the last "\" in the passed argument. 'when the last one is reached, strip off the full path, 'leaving the file name only. Dim lPosFound, lLastPosFound As Long lLastPosFound = 1 lPosFound = 1 While lPosFound <> 0 lPosFound = InStr(lLastPosFound, argFileName, "\") If lPosFound <> 0 Then lLastPosFound = lPosFound + 1 Wend StripOffPath = Right$(argFileName, Len(argFileName) - lLastPosFound + 1) End Function Sub SendTestCGIInfo() 'Dump the environment variables back to the user for testing purposes. Send "<H1>CGI & Enviroment Output</H1>" Send "<hr size=3>" Send "CGI_Server_Software = " & CGI_Server_Software & "<br>" Send "CGI_Server_Name = " & CGI_Server_Name & "<br>" Send "CGI_Server_URL = " & CGI_Server_URL & "<br>" Send "CGI_Gateway_Interface = " & CGI_Gateway_Interface & "<br>" Send "CGI_Server_Protocol = " & CGI_Server_Protocol & "<br>" Send "CGI_Server_Port = " & CGI_Server_Port & "<br>" Send "CGI_Request_Method = " & CGI_Request_Method & "<br>" Send "CGI_Path_Info = " & CGI_Path_Info & "<br>" Send "CGI_Path_Translated = " & CGI_Path_Translated & "<br>" Send "CGI_Script_Name = " & CGI_Script_Name & "<br>" Send "CGI_Query_String = " & CGI_Query_String & "<br>" Send "CGI_Remote_Host = " & CGI_Remote_Host & "<br>" Send "CGI_Remote_Addr = " & CGI_Remote_Addr & "<br>" Send "CGI_Referer = " & CGI_Referer & "<br>" Send "CGI_Auth_Type = " & CGI_Auth_Type & "<br>" Send "CGI_Remote_User = " & CGI_Remote_User & "<br>" Send "<b>CGI_Content_Type = " & CGI_Content_Type & "<br></b>" Send "<b>CGI_Content_Length = " & CGI_Content_Length & "<br></b>" Send "CGI_HTTPS = " & CGI_HTTPS & "<br>" Send "CGI_HTTPS_Key_Size = " & CGI_HTTPS_Key_Size & "<br>" Send "CGI_HTTPS_Secret_Key_Size = " & CGI_HTTPS_Secret_Key_Size & "<br>" Send "CGI_HTTP_Accept = " & CGI_HTTP_Accept & "<br>" Send "CGI_User_Agent = " & CGI_User_Agent & "<br>" Send "CGI_If_Modified_Since = " & CGI_If_Modified_Since & "<br>" Send "CGI_HTTP_From = " & CGI_HTTP_From & "<br>" End Sub Sub SendHeader(argTitle As String) 'Notice: When CGI's are sending HTML to a Web server, they must always 'follow the 'Content-type: text/html' with two carriage returns/line feeds ' 'Visual Basic recognized 'vbCrLf' as being a carriage return and a line feed. Send ("Content-type: text/html" & vbCrLf & vbCrLf) Send ("") Send ("<HTML><HEAD><TITLE>" & argTitle & "</TITLE></HEAD>") Send ("<BODY>") End Sub Sub SendFooter() 'Send a standard HTML footer. Send "<br>" Send "<hr>" Send "<FONT SIZE=-1>Do you have any feedback concerning this code? Please send it to " Send "<a href=""mailto:kempie@chesco.com"">Kent Empie</a>. Thanks.</FONT>" Send ("</BODY></HTML>") End Sub ' Send HTML output to standard out using the Win32API call "WriteFile" ' Sub Send(argString As String) Dim glResult As Long WriteFile GetStdHandle(STD_OUTPUT_HANDLE), argString & vbCrLf, Len(argString) + 2, glResult, ByVal 0& End Sub '============================================= 'Decode and replace the URL encoded data '============================================= ' Original Code by Paul Stohr (www.prplus.com) ' ' Data that we get back from STDIN will be URL encoded meaning that any spaces ' will be replaced with "+" and special characters will be replaced with ' "%<Hex value>" Example: Line feed and carriage return = "%0A%0D" ' ' NOTE: You should replace the "+" with spaces first since a "+" that a user ' may have entered will be URL encoded. By decoding "+" first to spaces ' will reduce the risk of replaceing a "+" that a user might have entered ' in the form. ' ' rpText = the text string to be decoded ' srchStr = the character to search for ' Note: Use "+" for spaces and "%" for "%<HEX value>" ' ' rpCmd = the character to replace the srchStr with ' Note: Use " " for spaces (obviously) and "HEX" for "%<HEX value>" ' Public Function ReplaceTxt(ByVal rpText As String, ByVal srchStr As String, ByVal rpCmd As String) As String Dim xString, perCnt As Long xString = 1 'We want to start at position 1 Do perCnt = InStr(xString, rpText, srchStr) 'Find the pos. of the next character If perCnt = 0 Then Exit Do 'No more found, Stop decoding If UCase(rpCmd) = "HEX" Then 'Lets replace the "%<HEX value>" rpText = Left$(rpText, perCnt - 1) & Chr(Val("&H" & (Mid$(rpText, perCnt + 1, 2)))) & Right$(rpText, Len(rpText) - perCnt - 2) xString = perCnt + 1 Else 'Lets replace the srchStr with rpCMD rpText = Left$(rpText, perCnt - 1) & rpCmd & Right$(rpText, Len(rpText) - perCnt - Len(srchStr) + 1) xString = perCnt + Len(rpCmd) End If Loop ReplaceTxt = rpText End Function 
