Broncode: PGP Encryptie Script

Een script dat e-mail versleuteld met behulp van PGP en een wrapper component.

Dit script wordt u aangeboden door Nedcomp Hosting. Om correct te kunnen functioneren moet de webserver waarop het wordt uitgevoerd zijn voorzien van PGP en een PGP wrapper component.

Standaard webservers hebben deze voorzieningen niet. Onze webservers zijn hiervan echter voorzien en daarop zal dit script correct functioneren.

zie ook: meer informatie    het script downloaden

<%
Option Explicit

Function EncryptMail(sBericht, sPGPFile, sTempdir)
'---------------------------------------------------------------------------------------------
' Het e-mail bericht dat verstuurd moet worden encrypten.
' sBericht bevat de body van het e-mail bericht en sPGPFile
' het pad naar een ascii bestand met daarin de passphrase.
'---------------------------------------------------------------------------------------------
Dim objPGP, objGuid, vGuid, sFileName, sPGPKey, sContent
On Error Resume Next

    '// De passphrase inlezen. Deze komt te staan in sPGPKey.
    If Not LoadTextFile(sPGPFile, sPGPKey) Then
    
        sBericht = GetErrorMSG(PGP_READERROR, sPGPFile)
        Exit Function
    End If

    '// Object voor het maken van een GUID.
    Set objGuid = Server.CreateObject("Scriptlet.TypeLib")
    If Err <> 0 Then: Exit Function

    '// De GUID maken.
    vGuid = objGuid.Guid
    Set objGuid = Nothing

    '// Unieke filenaam voor een tijdelijke file maken.
    If Right(sTempdir, 1) <> "\" Then: sTempdir = sTempdir & "\"
    sFileName = sTempdir & vGuid

    '// Het bericht opslaan zodat we het kunnen encrypten.
    If Not SaveTextFile(sFileName, sBericht) Then

        '// De mail kon niet worden geschreven naar een tempfile.
        sBericht = GetErrorMSG(PGP_READWRITEERROR, sFilename)
    Else

        '// Encrypten gebeurd met deze pgp wrapper.
        Set objPGP = Server.CreateObject("NSDPGP")
        objPGP.EncryptFile 2, sFileName, sFileName, sPGPKey

        If Err <> 0 Then

            '// Toch nog even proberen om op te ruimen.
            objPGP.WipeFile sFileName

            '// De mail kon niet encrypted worden.
            sBericht = GetErrorMSG(PGP_ERROR, "")
        Else
 
            '// De file met het encrypte e-mailbericht inlezen.
            If LoadTextFile(sFileName, sContent) Then
    
                '// Het nieuwe bericht is nu encrypted.
                sBericht = sContent
                EncryptMail = True
            Else
    
                '// De encrypted file was niet gevonden.
                sBericht = GetErrorMSG(PGP_READERROR, sFilename)
            End If

            '// De tempbestanden opruimen.
            objPGP.WipeFile sFileName
 
        End If

        Set objPGP = Nothing
    End If
End Function

Function LoadTextFile(sFileName, sContent)
'-------------------------------------------------------------------------------------------------------------------
' De in sFileName opgegeven tekstfile inlezen en retourneren in sContent.
'-------------------------------------------------------------------------------------------------------------------
Dim objFileSystem, objTextStream, sTemp
On Error Resume Next

    Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
    Set objTextStream = objFileSystem.OpenTextFile(sFileName, 1, 0)

    If Err = 0 Then

        sTemp = objTextStream.ReadAll
        objTextStream.Close
    End If

    Set objTextStream = Nothing
    Set objFileSystem = Nothing

    If Err.Number = 0 Then

        sContent = sTemp
        LoadTextFile = True
    End If
 
End Function

Function SaveTextFile(sFileName, sContent)
'----------------------------------------------------------------------------------------------------------------------------
' De tekst in sContent wegschrijven naar een file die is opgegeven in sFilename.
'----------------------------------------------------------------------------------------------------------------------------
Dim objFileSystem, objTextStream
On Error Resume Next

    Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
    Set objTextStream = objFileSystem.CreateTextFile(sFileName, True, False)

    If Err > 0 Then

        Set objTextStream = Nothing
        Set objFileSystem = Nothing
        Exit Function
    End If

    objTextStream.Write sContent

    objTextStream.Close
    Set objTextStream = Nothing
    Set objFileSystem = Nothing

    If Err.Number = 0 Then: SaveTextFile = True
 
End Function

Function GetErrorMSG(MSGNumber, Para2)
'-----------------------------------------------
' Een foutmelding retourneren.
'-----------------------------------------------
Dim strMSG

    Select Case MSGNumber

        Case PGP_READERROR
    
            strMSG = "hier foutmelding 1: pgp file niet gevonden of toegang geweigerd fout."
    
        Case PGP_READWRITEERROR
    
            strMSG = "hier foutmelding 2: tempdir ongeldig of toegang daartoe geweigerd."
 
        Case PGP_ERROR
    
            strMSG = "hier foutmelding 3: pgp fout."
 
    End Select
 
    GetErrorMSG = strMSG
End Function
%>

<html><head><title>PGP Mail Encryptie</title></head><body>
 
<%
'---------------------------------------------------------------------------------
'---- Begin Hoofdprocedure -------------------------------------->
'---------------------------------------------------------------------------------
Dim sMailBody, sPassFile, sTempdir
Const PGP_READERROR = 1, PGP_READWRITEERROR = 2, PGP_ERROR = 3

    '// De tekst van het bericht dat we willen versturen.
    sMailBody = "Dit is de niet versleutelde body van het e-mail bericht"
 
    '// Directory met lees-rechten.
    sPassFile = "w:\websites\domein.nl\geheim\pgpkey.txt" 
 
    '// Directory met lees- en schrijf rechten.
    sTempdir = "w:\websites\domein.nl\data\"
    
    '// De mail encrypten. Het resultaat komt in sMailBody of deze gaat
    '// een foutmelding bestaande uit bijvoorbeeld een complete pagina bevatten.
    If EncryptMail(sMailBody, sPassFile, sTempdir) Then
 
        '// De mail kan verstuurd worden, bijvoorbeeld met CDO
        '// of ieder willekeurig mail component.
        %>
 
        <p>Succes!. Dit is het bericht dat u kunt versturen:</p>
        <p><pre><%= sMailBody %></pre></p>
 
    <% Else
 
        Response.Write sMailBody
    End If %> 
 
</body></html>