[Gvsig_usuarios] Problema de acceso a símbolos y estilos por defecto

[mmarco]

Hola, 

El .bat siguiente (S.O Windows) crea la carpeta gvSIG en el Homepath del
usuario y copia los datos que se encuentran en una unidad de red (en caso
que la carpeta ya existiera, crea un backup de dicha carpeta). A
continuación crea un acceso directo a la instalación de gvSIG en red.

El contenido del bat seria :
/@echo off 
cscript *setup.vbs*
pause/

A continuación está el texto del archivo *setup.vbs*. Hay que personalizar
las cuatro primeras variables según necesidades. Si alguien consigue
mejorarlo o conoce alguna solución mas elegante se agradece la aportación. 

Un saludo,
Montse

/
Dim exegvSIG,wrkDir,icona,srcFolder

'ruta donde se encuentran el ejecutable
exegvSIG = "O:\Projectes\gvSIG\bin\gvSIG.exe" 
'ruta del directorio de trabajo
wrkDir="O:\Projectes\gvSIG\bin"
'ruta donde se encuentra el icono de gvSIG
icona="O:\Projectes\gvSIG\bin\ico-gvSIG.ico"
'ruta donde se encuentran aquellos ficheros que queremos que se copien en la
carpeta gvSIG del perfil de usuario
srcFolder = "O:\Projectes\gvSIG\setup\profile" 


Wscript.Echo "Instal·lant gvSIG..." 
CopyFilesAndFolders()
CrearAccesDirecte()

 
 Sub CopyFilesAndFolders()
 Dim wshShell, fs, objFolder, dt
 Dim wshSysEnv,  sMyHomePath ,sMyHomegvSIG 
 
 ' obtenemos la ruta del HOMEPATH
 Set wshShell = WScript.CreateObject("WScript.Shell")
 Set wshSysEnv = wshShell.Environment("PROCESS")
 sMyHomePath = wshSysEnv("USERPROFILE")
 
 ' comprobamos si existe la carpeta gvSIG
 sMyHomegvSIG = sMyHomePath & "\gvSIG" 
 Set fs = CreateObject("Scripting.FileSystemObject")
 if not fs.FolderExists(sMyHomegvSIG) = True then
	' creación de la carpeta %USERPROFILE%\gvSIG
	Set objFolder = fs.CreateFolder(sMyHomegvSIG) 
 else
	' backup de la carpeta %USERPROFILE%\gvSIG ya existente 
	' la guardamos por si acaso, ya que el usuario tal vez ha guardado
información (nuevos símbolos, etc...)
	ara= Now()
	ara=replace(ara,"/","-")
	ara=replace(ara,":","-")
	sMyHomegvSIGBck = sMyHomePath & "\gvSIG " & ara	
	Wscript.Echo "La carpeta  " & sMyHomegvSIG & " ja existeix." 
	Wscript.Echo "Fem còpia de seguretat d'aquesta carpeta a " &
sMyHomegvSIGBck
	fs.MoveFolder sMyHomegvSIG , sMyHomegvSIGBck
 end if
 'Copiamos el contenido de la carpeta en red a %USERPROFILE%\gvSIG
 Wscript.Echo "Còpia dels arxius de configuració a  " & sMyHomegvSIG
 Copiar srcFolder, sMyHomegvSIG
 
End Sub

Sub Copiar (ByVal strSource, ByVal strDestination)
    Dim ObjFSO, ObjFolder, ObjSubFolder, ObjFile, files
    Dim TargetPath
    Set ObjFSO = CreateObject("scripting.filesystemobject")
    'connecting to the folder where is going to be searched
    Set ObjFolder = ObjFSO.GetFolder(strSource)
    TargetPath = Replace (objFolder.path & "\", strSource,
strDestination,1,-1,vbTextCompare)
    If Not ObjFSO.FolderExists (TargetPath) Then ObjFSO.CreateFolder
(TargetPath)
    Err.clear
    On Error Resume Next
    'Check all files in a folder
    For Each objFile In ObjFolder.files
        If Err.Number <> 0 Then Exit For 'If no permission or no files in
folder
        On Error goto 0
        If CheckToCopyFile (objFile.path, TargetPath & "\" & objFile.name)
Then 
            objFSO.copyfile objFile.path, TargetPath & "\" & objFile.name,
True
        End If
    Next
    'Recurse through all of the subfolders
    On Error Resume Next
    Err.clear
    For Each objSubFolder In ObjFolder.subFolders
        If Err.Number <> 0 Then Exit For 'If no permission or no subfolder
in folder
        On Error goto 0
        'For each found subfolder there will be searched for files
        Copiar ObjSubFolder.Path & "\", TargetPath & ObjSubFolder.name & "\"
    Next
    Set ObjFile = Nothing
    Set ObjSubFolder = Nothing
    Set ObjFolder = Nothing
    Set ObjFSO = Nothing
End Sub

Function CheckToCopyFile (ByVal strSourceFilePath, ByVal strDestFilePath)
    Dim oFSO, oFile, SourceFileModTime, DestFileModTime
    CheckToCopyFile = True
    Set oFSO = CreateObject("scripting.filesystemobject")
    If Not oFSO.FileExists (strDestFilePath) Then Exit Function
    Set oFile = oFSO.GetFile (strSourceFilePath)
    SourceFileModTime = oFile.DateLastModified
    Set oFile = Nothing
    Set oFile = oFSO.GetFile (strDestFilePath)
    DestFileModTime = oFile.DateLastModified
    Set oFile = Nothing
    If SourceFileModTime =< DestFileModTime Then CheckToCopyFile = False
    Set oFSO = Nothing
End Function


Sub CrearAccesDirecte()
  Dim WSHShell
  Set WSHShell = WScript.CreateObject("WScript.Shell")
  Dim MyShortcut, MyDesktop, DesktopPath
  ' Read desktop path using WshSpecialFolders object
  DesktopPath = WSHShell.SpecialFolders("Desktop")
  ' Create a shortcut object on the desktop
  Set MyShortcut = WSHShell.CreateShortcut( DesktopPath & "\gvSIG.lnk")
  ' Set shortcut object properties and save it
  MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(exegvSIG)
  MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(wrkDir)
  MyShortcut.WindowStyle = 4
  MyShortcut.IconLocation = icona
  MyShortcut.Save
  Wscript.Echo "Instal·lació realitzada amb èxit" 
  WScript.Echo "L'escriptori conté un accés directe a gvSIG"
  WScript.Quit
 End Sub

/

--
View this message in context: http://osgeo-org.1560.n6.nabble.com/Problema-de-acceso-a-simbolos-y-estilos-por-defecto-tp4948928p4974948.html
Sent from the gvSIG usuarios mailing list archive at Nabble.com.