Option Explicit Dim wshshell,fso,i,Fnct Dim strPath,strSystemFolder,strWinFolder,strTempFolder Dim strLabelSourcePath,strMainVolume Dim Label,Labelfiles,SerialNo,File,SoftwareFile,Filename,tmpSerialNo Dim strSoftwareTxt '----------------------------- Objekte erzeugen -------------------------------- i = 0 On Error Resume Next Do err.Clear i = i+1 Set wshshell = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set Fnct = CreateObject("Install.Functions") WScript.Sleep 1000 Loop Until Err.Number = 0 OR i > 30 If Err.Number <> 0 Then WScript.Quit End If On Error Goto 0 '--------------------------- Standardpfade ------------------------------------- strPath = GetCurrentPath() strSystemFolder = fso.GetSpecialFolder(1) & "\" strWinFolder = fso.GetSpecialFolder(0) & "\" strTempFolder = fso.GetSpecialFolder(2) & "\" SerialNo = "" strLabelSourcePath = ExpandPath("%LABEL_SOURCE_DIR%","d:\Label") strMainVolume = ExpandPath("%MAIN_VOLUME%","c:\") strSoftwareTxt = strMainVolume & "Software.txt" '------------------------------ Main ------------------------------------------- if fso.FolderExists(strLabelSourcePath) Then Call fso.CopyFolder(strLabelSourcePath,strMainVolume,True) Set Label = fso.GetFolder(strLabelSourcePath) Set Labelfiles = Label.Files If Labelfiles.Count >= 1 THEN For Each File In Labelfiles Filename = UCase(File.name) If Instr(Filename,".TXT") > 0 Then Set SoftwareFile = fso.OpenTextFile(strLabelSourcePath+Filename) SerialNo = SoftwareFile.ReadLine() SoftwareFile.Close() End If tmpSerialNo = Left(Filename,Instr(Filename,".")-1) Next end if If SerialNo = "" Then SerialNo = tmpSerialNo End If If fso.FileExists(strSoftwareTxt) Then Set Softwarefile = fso.GetFile(strSoftwareTxt) Softwarefile.Attributes = Softwarefile.Attributes And Not 216 And Not 1 ' Schreibschutz End If Set SoftwareFile = fso.OpenTextFile(strSoftwareTxt,8,True) Call SoftwareFile.WriteBlankLines(2) Call SoftwareFile.WriteLine("PC-Seriennummer: " & SerialNo) SoftwareFile.Close Call Fnct.SetIniString("IPC","Serial",SerialNo,strMainVolume & "Computer.ini") '------------------------------- Funktionen ------------------------------------ Function GetCurrentPath() Dim l_strScriptName Dim l_strTemp l_strScriptName = WScript.ScriptFullName l_strTemp = WScript.ScriptName GetCurrentPath = Left(l_strScriptName, Len(l_strScriptName) - Len(l_strTemp)) End Function Function ExpandPath(p_strEnvironment,p_strDefault) Dim l_strTemp l_strTemp = wshshell.ExpandEnvironmentStrings(p_strEnvironment) If l_strTemp = p_strEnvironment Then l_strTemp = p_strDefault End If ExpandPath = l_strTemp End Function