Guest User

HTA

a guest
Jun 30th, 2015
768
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
HTML 10.03 KB | None | 0 0
  1. <!doctype html>
  2.  
  3. <html lang="en">
  4.     <head>
  5.  
  6.         <!--[if lt IE 9]>
  7.         <script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>
  8.         <![endif]-->
  9.    
  10.         <script language="VBScript">
  11.  
  12.             Window.ResizeTo 1200,700
  13.             WinWidth = 1200
  14.             WinHeight = 700
  15.  
  16.             Sub CenterWindow( widthX, heightY )
  17.                 Window.MoveTo (screen.Width - widthX)/2, (screen.Height - heightY)/3
  18.             End Sub
  19.            
  20.             CenterWindow WinWidth, WinHeight
  21.            
  22.         </script>
  23.    
  24.         <title> PortableFL Launcher</title>
  25.         <HTA:APPLICATION
  26.         ApplicationName="PortableFL Launcher"
  27.         Border="Thin"
  28.         BorderStyle="Raised"
  29.         Caption="Yes"
  30.         ContextMenu="No"
  31.         Icon="AppData/Launcher/FL.ico"
  32.         ID="Launcher"
  33.         MaximizeButton="No"
  34.         MinimizeButton="No"
  35.         ShowInTaskbar="Yes"
  36.         SingleInstance="Yes"
  37.         SysMenu="Yes"
  38.         WindowState="Normal"
  39.         InnerBorder="No"
  40.         Navigable="Yes"
  41.         Scroll="no"
  42.         ScrollFlat="yes"
  43.         Selection="No"
  44.         Version="1.0"
  45.         />
  46.  
  47.         <meta charset="utf-8">
  48.         <meta name="description" content="PortableFL Launcher">
  49.         <meta name="author" content="Zyos">
  50.  
  51.         <link rel="stylesheet" href="AppData/Launcher/styles.css?v=1.0">
  52.            
  53.     </head>
  54.  
  55. <script language='VBScript'>
  56.    
  57.     Set objShell = CreateObject("WScript.Shell")
  58.     Set fsObject = CreateObject("Scripting.FileSystemObject")
  59.  
  60.     '-- Set custom variables.
  61.     OsType = objShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PROCESSOR_ARCHITECTURE")
  62.     ImportPathX64 = objShell.ExpandEnvironmentStrings("%PROGRAMFILES(X86)%")
  63.     ImportPathX86 = objShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
  64.     GamePath = "Microsoft Games\Freelancer\EXE"
  65.     AppPath = objShell.CurrentDirectory
  66.    
  67.    
  68.     Function ReadIni( myFilePath, mySection, myKey )
  69.     ' This function returns a value read from an INI file
  70.     '
  71.     ' Arguments:
  72.     ' myFilePath  [string]  the (path and) file name of the INI file
  73.     ' mySection   [string]  the section in the INI file to be searched
  74.     ' myKey       [string]  the key whose value is to be returned
  75.     '
  76.     ' Returns:
  77.     ' the [string] value for the specified key in the specified section
  78.     '
  79.     ' CAVEAT:     Will return a space if key exists but value is blank
  80.     '
  81.     ' Written by Keith Lacelle
  82.     ' Modified by Denis St-Pierre and Rob van der Woude
  83.  
  84.     Const ForReading   = 1
  85.     Const ForWriting   = 2
  86.     Const ForAppending = 8
  87.  
  88.     Dim intEqualPos
  89.     Dim objFSO, objIniFile
  90.     Dim strFilePath, strKey, strLeftString, strLine, strSection
  91.  
  92.     Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  93.  
  94.     ReadIni     = ""
  95.     strFilePath = Trim( myFilePath )
  96.     strSection  = Trim( mySection )
  97.     strKey      = Trim( myKey )
  98.  
  99.     If objFSO.FileExists( strFilePath ) Then
  100.         Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
  101.         Do While objIniFile.AtEndOfStream = False
  102.             strLine = Trim( objIniFile.ReadLine )
  103.  
  104.             ' Check if section is found in the current line
  105.             If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
  106.                strLine = Trim( objIniFile.ReadLine )
  107.  
  108.                ' Parse lines until the next section is reached
  109.                Do While Left( strLine, 1 ) <> "["
  110.                    ' Find position of equal sign in the line
  111.                    intEqualPos = InStr( 1, strLine, "=", 1 )
  112.                    If intEqualPos > 0 Then
  113.                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
  114.                        ' Check if item is found in the current line
  115.                        If LCase( strLeftString ) = LCase( strKey ) Then
  116.                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
  117.                            ' In case the item exists but value is blank
  118.                            If ReadIni = "" Then
  119.                                ReadIni = " "
  120.                            End If
  121.                            ' Abort loop when item is found
  122.                            Exit Do
  123.                        End If
  124.                    End If
  125.  
  126.                    ' Abort if the end of the INI file is reached
  127.                    If objIniFile.AtEndOfStream Then Exit Do
  128.  
  129.                    ' Continue with next line
  130.                    strLine = Trim( objIniFile.ReadLine )
  131.                Loop
  132.            Exit Do
  133.            End If
  134.        Loop
  135.        objIniFile.Close
  136.    Else
  137.        WScript.Echo strFilePath & " doesn't exists. Exiting..."
  138.        Wscript.Quit 1
  139.    End If
  140. End Function
  141.  
  142.  
  143. Sub WriteIni( myFilePath, mySection, myKey, myValue )
  144.    ' This subroutine writes a value to an INI file
  145.    '
  146.    ' Arguments:
  147.    ' myFilePath  [string]  the (path and) file name of the INI file
  148.    ' mySection   [string]  the section in the INI file to be searched
  149.    ' myKey       [string]  the key whose value is to be written
  150.    ' myValue     [string]  the value to be written (myKey will be
  151.    '                       deleted if myValue is <DELETE_THIS_VALUE>)
  152.    '
  153.    ' Returns:
  154.    ' N/A
  155.    '
  156.    ' CAVEAT:     WriteIni function needs ReadIni function to run
  157.    '
  158.    ' Written by Keith Lacelle
  159.    ' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
  160.  
  161.    Const ForReading   = 1
  162.    Const ForWriting   = 2
  163.    Const ForAppending = 8
  164.  
  165.    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
  166.    Dim intEqualPos
  167.    Dim objFSO, objNewIni, objOrgIni, wshShell
  168.    Dim strFilePath, strFolderPath, strKey, strLeftString
  169.    Dim strLine, strSection, strTempDir, strTempFile, strValue
  170.  
  171.    strFilePath = Trim( myFilePath )
  172.    strSection  = Trim( mySection )
  173.    strKey      = Trim( myKey )
  174.    strValue    = Trim( myValue )
  175.  
  176.    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  177.    Set wshShell = CreateObject( "WScript.Shell" )
  178.  
  179.    strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
  180.    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
  181.  
  182.    Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
  183.    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
  184.  
  185.    blnInSection     = False
  186.    blnSectionExists = False
  187.    ' Check if the specified key already exists
  188.    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
  189.    blnWritten       = False
  190.  
  191.    ' Check if path to INI file exists, quit if not
  192.    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
  193.    If Not objFSO.FolderExists ( strFolderPath ) Then
  194.        WScript.Echo "Error: WriteIni failed, folder path (" _
  195.                   & strFolderPath & ") to ini file " _
  196.                   & strFilePath & " not found!"
  197.        Set objOrgIni = Nothing
  198.        Set objNewIni = Nothing
  199.        Set objFSO    = Nothing
  200.        WScript.Quit 1
  201.    End If
  202.  
  203.    While objOrgIni.AtEndOfStream = False
  204.        strLine = Trim( objOrgIni.ReadLine )
  205.        If blnWritten = False Then
  206.            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
  207.                blnSectionExists = True
  208.                blnInSection = True
  209.            ElseIf InStr( strLine, "[" ) = 1 Then
  210.                blnInSection = False
  211.            End If
  212.        End If
  213.  
  214.        If blnInSection Then
  215.            If blnKeyExists Then
  216.                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
  217.                If intEqualPos > 0 Then
  218.                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
  219.                    If LCase( strLeftString ) = LCase( strKey ) Then
  220.                        ' Only write the key if the value isn't empty
  221.                        ' Modification by Johan Pol
  222.                        If strValue <> "<DELETE_THIS_VALUE>" Then
  223.                            objNewIni.WriteLine strKey & "=" & strValue
  224.                        End If
  225.                        blnWritten   = True
  226.                        blnInSection = False
  227.                    End If
  228.                End If
  229.                If Not blnWritten Then
  230.                    objNewIni.WriteLine strLine
  231.                End If
  232.            Else
  233.                objNewIni.WriteLine strLine
  234.                    ' Only write the key if the value isn't empty
  235.                    ' Modification by Johan Pol
  236.                    If strValue <> "<DELETE_THIS_VALUE>" Then
  237.                        objNewIni.WriteLine strKey & "=" & strValue
  238.                    End If
  239.                blnWritten   = True
  240.                blnInSection = False
  241.            End If
  242.        Else
  243.            objNewIni.WriteLine strLine
  244.        End If
  245.    Wend
  246.  
  247.    If blnSectionExists = False Then ' section doesn't exist
  248.        objNewIni.WriteLine
  249.        objNewIni.WriteLine "[" & strSection & "]"
  250.            ' Only write the key if the value isn't empty
  251.            ' Modification by Johan Pol
  252.            If strValue <> "<DELETE_THIS_VALUE>" Then
  253.                objNewIni.WriteLine strKey & "=" & strValue
  254.            End If
  255.    End If
  256.  
  257.    objOrgIni.Close
  258.    objNewIni.Close
  259.  
  260.    ' Delete old INI file
  261.    objFSO.DeleteFile strFilePath, True
  262.    ' Rename new INI file
  263.    objFSO.MoveFile strTempFile, strFilePath
  264.  
  265.    Set objOrgIni = Nothing
  266.    Set objNewIni = Nothing
  267.    Set objFSO    = Nothing
  268.    Set wshShell  = Nothing
  269. End Sub
  270.  
  271.     WriteIni "config.ini", "bgAudio", "AutoPlay", "True"
  272.    
  273. </script>
  274.  
  275. <body bgcolor="#FAFAFA">
  276.     <div class='launcher'>
  277.  
  278.         <div class='button'>
  279.        
  280.             <script language="VBScript">
  281.  
  282.                 If fsObject.FileExists("" & AppPath & "\" & GamePath & "\Freelancer.exe") Then
  283.                     ' Show play button
  284.                     Document.Write("<input class='button' type='button' value='Play' name='run_button' onClick='Play'><p>")
  285.  
  286.                 ElseIf fsObject.FolderExists("" & ImportPathX86 & "\" & GamePath & "") Then
  287.                     ' Show install button
  288.                     Document.Write("<input class='button' type='button' value='Install' name='run_button' onClick='Install'><p>")
  289.    
  290.                 Else
  291.                     '-- Throw up a message to inform the user that Freelancer is not installed.
  292.                     Document.Write("<input class='button' type='button' value='Error' name='run_button' onClick=''><p>")
  293.                 End If
  294.             </script>
  295.        
  296.         </div>
  297.  
  298.     </div>
  299.    
  300. </body>
  301. </html>
Advertisement
Add Comment
Please, Sign In to add comment