Eintrag in Registry für Demo - Version
22.11.2003 19:40:43
JaHosna
ich hab ein kleines Problem. Ich möchte gerne beim Erstmaligen installieren der Software (eigenes Excel-Sheet) einen Eintrag in die Registry machen und diesen Eintrag bei jedem Start abfragen. Wenn ein Datumswert oder ein Registrierschlüssel in einer "getarnten" Datei XXX.dll nicht übereinstimmt, soll die Ausführung nicht mehr möglich sein.
Mein Code bis jetzt - er funktioniert aber net ganz, wer kann mir da unter die Arme greifen
Option Explicit
Type Datensatz ' Datentyp definieren.
Kennung As Integer
Name As String * 8
End Type
Sub Auto_open() ' Bei Öffnen von Datei sofort ausführen
On Error Resume Next ' Bei Fehler weitermachen.
Dim Datei1, aName, a ' Variable von Typ Variant definieren.
Dim DSatz1 As Datensatz, DSatzNummer, Position
Dim xlAnw As Word.Application 'das geht leider net ???
Set xlAnw = CreateObject("Word.Application")
'Neue Datei erzeugen
Open "freiname.dll" For Random As #1 Len = Len(DSatz1)
ChDir "C:\WINDOWS"
Datei1 = Dir("C:\WINDOWS\ freiname.dll ") ' Variable Datei1 besetzen
' Bedienung prüfen: Wenn kein Eintrag in untergenanten String (False) oder freiname.dll nicht existiert dann:
If Datei1 = "" Or (xlAnw.System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "LogFile") = False) Then
' Eine Datei im Hintergrund auf der Festplatte erzeugen und dort ein Wert speichern.
DSatzNummer = 1
DSatz1.Kennung = DSatzNummer ' Kennung definieren.
DSatz1.Name = Hex(Date) ' Zeichenfolge erstellen (z.b. Datum in Hex Format).
Put #1, DSatzNummer, DSatz1 ' Zeichenfolge dort schreiben.
Close #1 ' Datei schließen
SetAttr Datei1, vbHidden + vbSystem
'Zusätzlich noch Eintrag in Registry vornehmen.
xlAnw.System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "LogFile") = Hex(Date)
End If
Open " freiname.dll " For Random As #1
Len = Len(DSatz1)
Position = 1 Get #1, Position, DSatz1 '1. Datensatz lesen
a = DSatz1.Name ' in Variable speichern
Close ' Datei schließen.
aName = System.PrivateProfileString("", _ "HKEY_CURRENT_USER\Software\Microsoft\" _
& "MS Setup (ACME)\User Info", "LogFile")
' Bedienung zum weitermachen.
If a < Hex(Date - 30) Or aName < Hex(Date - 30) Then
MsgBox "Testversion! Zeit ist abgelaufen. Bestellung per E-Mail:" & _
Chr(13) & Chr(10) & " XXX@XXX.de", , "XXX"
Application.ThisWorkbook.Close SaveChanges:=False
Else
CAll XXXX
End If
Set xlAnw = Nothing ' Erstellte Word Objekt vom Speichern entfernen.
End Sub