Page 1 of 1 1
Topic Options
#126545 - 2004-09-11 12:26 AM Array Problem
@lejo @rias Offline
Starting to like KiXtart

Registered: 2003-09-02
Posts: 100
Loc: Medellin, Colombia
HELP PLS!!!
Hi, I use UDF Dirplus()

this work fine when use in 1 drive ex c: but when I need use in many drives like c:, d:, e: return a error
Code work fine:
Code:
 
$origen="c:\"
$FileExt=".doc;.xls;.ppt;.zip;.nsf"
$FullList=DirPlus($origen,$FileExt,1)
For Each $el In $FullList
?$el
Next



Code error:

Code:

$origen="c:\","d:\"
For Each $dr In $origen
$FileExt=".doc;.xls;.ppt;.zip;.nsf"
$fulllist=DirPlus($dr,$FileExt,1)
Next




this is the udf

Code:



Function DirPlus($Dir,$mask,optional $subfolders, optional $datatype)
Dim $file, $subflag, $i, $ii,$pattern
If VarType($_temparray) = 0
Global $_temparray[30], $_i
$_i = 0
Else
$subflag = 1
EndIf
If $Dir = 0 Exit(1) EndIf
If SubStr($Dir,Len($Dir),1) = "\"
$Dir = SubStr($Dir,1,Len($Dir)-1)
EndIf
If $mask = 0
$mask = "*.*"
EndIf
$mask = Split($mask,";")
If Exist($Dir) = 0 Exit(2) EndIf
$file = Dir($Dir + "\*.*")
While @error = 0 AND $file
Select
Case $file = "." OR $file = ".."
;bit bucket!
Case GetFileAttr($Dir + "\" + $file) & 16
$_temparray[$_i] = $Dir + "\" + $file
$_i = $_i + 1
If $subfolders = 1
dirplus($Dir + "\" + $file,"*.*",$subfolders)
If @error <> 0 Exit(1) EndIf
EndIf
Case 1
$_temparray[$_i] = $Dir + "\" + $file
$_i = $_i + 1
EndSelect
If Ubound($_temparray) = $_i
ReDim preserve $_temparray[$_i + 30]
EndIf
$file = Dir("")
Loop

If $subflag = 1
;
Else
ReDim preserve $_temparray[$_i-1]
$dirplus = $_temparray
Select
Case $mask[0] = "*.*"
;return all files!
Case 1
Dim $temparray[Ubound($dirplus)]
$ii = 0
For Each $pattern In $mask
$i = 0
For Each $file In $dirplus
If InStr($file,$pattern)
$temparray[$ii] = $dirplus[$i]
$ii = $ii + 1
EndIf
$i = $i + 1
Next
Next
If $ii > 0
ReDim preserve $temparray[$ii-1]
$dirplus = $temparray
Else
$dirplus = 0
EndIf
EndSelect
Select
Case $datatype = 0
;return filename!
Case $datatype = 1
;return File object handle
$i = 0
$fso = CreateObject("scripting.filesystemobject")
If @error <> 0 AND VarType($fso) <> 9 Exit(@errro) EndIf
For Each $file In $dirplus
If GetFileAttr($file) & 16
$file = $fso.getfolder($file)
Else
$file = $fso.getfile($file)
EndIf
$dirplus[$i] = $file
$i = $i + 1
Next
EndSelect
$_i = 0
$_temparray = 0
Exit(0)
EndIf
EndFunction

_________________________
Look always 4 the best...

Top
#126546 - 2004-09-11 01:08 AM Re: Array Problem
Les Offline
KiX Master
*****

Registered: 2001-06-11
Posts: 12734
Loc: fortfrances.on.ca
What makes you think the DirPlus() UDF supports an array as the first parm [$origen="c:\","d:\"]? There is nothing in the comments or examples that would suggest that you can enter an array as the first parm.
_________________________
Give a man a fish and he will be back for more. Slap him with a fish and he will go away forever.

Top
#126547 - 2004-09-11 01:27 AM Re: Array Problem
maciep Offline
Korg Regular
*****

Registered: 2002-06-14
Posts: 947
Loc: Pittsburgh
i'm not seeing that les. looks like he passing an element from an array. I think it may be that he is trying to assign and arrary to an array, but not sure would have to test
_________________________
Eric

Top
#126548 - 2004-09-11 01:31 AM Re: Array Problem
maciep Offline
Korg Regular
*****

Registered: 2002-06-14
Posts: 947
Loc: Pittsburgh
what's the error you're seeing?
_________________________
Eric

Top
#126549 - 2004-09-11 01:44 AM Re: Array Problem
Les Offline
KiX Master
*****

Registered: 2001-06-11
Posts: 12734
Loc: fortfrances.on.ca
Doh! I misread the code.
In his non-array version he has:
$FullList=DirPlus($origen,$FileExt,1)

Then I saw $origen as an array and jumped to conclusions.

If memory serves, there was talk about a recursion problem. See kraborn's comment "If I try to run this function two time in a row I get this error on the second call".
_________________________
Give a man a fish and he will be back for more. Slap him with a fish and he will go away forever.

Top
#126550 - 2004-09-11 01:47 AM Re: Array Problem
maciep Offline
Korg Regular
*****

Registered: 2002-06-14
Posts: 947
Loc: Pittsburgh
yep, i think it might be the global declaration of $_temparray
_________________________
Eric

Top
#126551 - 2004-09-11 04:12 AM Re: Array Problem
Bryce Offline
KiX Supporter
*****

Registered: 2000-02-29
Posts: 3167
Loc: Houston TX
yes this UDF is totaly broken on multiple calls...... i keep trying to fix it, but never seems to find the time.



sorry.
Bryce

Top
#126552 - 2004-09-11 05:09 AM Re: Array Problem
Les Offline
KiX Master
*****

Registered: 2001-06-11
Posts: 12734
Loc: fortfrances.on.ca
Well... even if the UDF didn't have a recursion problem, this code would never work.
Code:
$origen="c:\","d:\"
For Each $dr In $origen
$FileExt=".doc;.xls;.ppt;.zip;.nsf"
$fulllist=DirPlus($dr,$FileExt,1)
Next



Every iteration of the For Next loop would overwrite $fulllist from the previous iteration.

You might want to give Jens' DirList() UDF a go but you would still have to rethink the above issue.
_________________________
Give a man a fish and he will be back for more. Slap him with a fish and he will go away forever.

Top
#126553 - 2004-09-11 11:14 AM Re: Array Problem
ChristopheM Offline
Hey THIS is FUN
*****

Registered: 2002-05-13
Posts: 311
Loc: STRASBOURG, France
what do you want exactly as result if subfolder is set ?
Do you want a list of just files that match extension
or do you want a list of files and dirs that match extension
or do you a list of files that match extension and all subdirs ?

I started to write a new version of your DirPlus function without global array and problem of recursion but i need more informations.

is it really interesting to get fso object in the dirplus function ?
why not write 2 functions :
- one that returns a list of name
- one that returns a list of fso object

_________________________
Christophe

Top
#126554 - 2004-09-11 11:36 PM Re: Array Problem
Bryce Offline
KiX Supporter
*****

Registered: 2000-02-29
Posts: 3167
Loc: Houston TX
ha!! i did it!!

the following is a major revision of my origional DIRPLUS() udf.... this only reutrns files/folders, and does not give you the option of filtering on using file extension (i will add this feature once i have a full replacement for the original UDF)

This also returns the FSO object of folders/files as a defalut return.

Code:

function DirPlus($path,optional $sfflag)
dim $fso, $f, $tf, $folder, $file, $i, $temp, $item
dim $tarray[0]
$fso = CreateObject("Scripting.FileSystemObject")
$f = $fso.getfolder($path)
for each $folder in $f.subfolders
$tarray[$i] = $folder
$i = $i + 1
redim preserve $tarray[$i]
if $sfflag
$temp = dirplus($folder, $sfflag)
for each $item in $temp
$tarray[$i] = $item
$i = $i + 1
redim preserve $tarray[$i]
next
endif
next
for each $file in $f.files
$tarray[$i] = $file
$i = $i + 1
redim preserve $tarray[$i]
next

if $i
redim preserve $tarray[$i-1]
else
$tarray = 0
endif
$dirplus = $tarray
endfunction




an example....

Code:

$dir = dirplus("c:\program files",1) ;return all subfolder information

;Using the FSO to return information
for each $file in $dir
if $file.type <> "file folder"
? "file name = " $file.name
? "File type = " $file.type
? "FIle size = " $file.size
endif
next



Bryce


Edited by Bryce (2004-09-11 11:37 PM)

Top
#126555 - 2004-09-12 02:11 AM Re: Array Problem
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11631
Loc: CA
What about return error codes if invalid forlder or other issue Bryce?
Top
#126556 - 2004-09-12 06:03 AM Re: Array Problem
Bryce Offline
KiX Supporter
*****

Registered: 2000-02-29
Posts: 3167
Loc: Houston TX
working on it , just wanted to post a working dirplus() replacement.
Top
#126557 - 2004-09-12 06:48 AM Re: Array Problem
Les Offline
KiX Master
*****

Registered: 2001-06-11
Posts: 12734
Loc: fortfrances.on.ca
But lacking the ability to filter on extension, it is of little value to @lejo.
_________________________
Give a man a fish and he will be back for more. Slap him with a fish and he will go away forever.

Top
#126558 - 2004-09-12 07:08 AM Re: Array Problem
Bryce Offline
KiX Supporter
*****

Registered: 2000-02-29
Posts: 3167
Loc: Houston TX
working on it....

I totaly rebuilt this UDF from scratch.

Top
#126559 - 2004-09-12 08:43 PM Re: Array Problem
ChristopheM Offline
Hey THIS is FUN
*****

Registered: 2002-05-13
Posts: 311
Loc: STRASBOURG, France
Here is the recursive version with the original parameters (just a new optional parameter "verbose")

Code:

$=SetOption( "Explicit", "ON" )
$=SetOption( "NoVarsInStrings", "ON" )

dim $arrPath, $Path, $FileExt, $FullList, $name

$arrPath = "c:\", "d:\"

$FileExt=".doc;.xls;.ppt;.zip;.nsf"

For Each $Path In $arrPath
if $path
"-------------------------------------------------------" ?
" "+$Path ?
"-------------------------------------------------------" ?
$FullList = DirPlus($Path, $FileExt, 1, 0, 1)

for each $name in $FullList
$name ?
next
endif
Next


Function DirPlus($Dir, $mask, optional $subfolders, optional $datatype, optional $verbose)
Dim $SubDirIndex, $SubDirSize, $SubDirSizeInc
$SubDirSize = 0
$SubDirSizeInc = 16
$SubDirIndex = -1
Dim $arrSubdir[$SubDirSize]

Dim $FileArrayIndex, $FileArraySize, $FileArraySizeInc
$FileArraySize = 0
$FileArraySizeInc = 16
$FileArrayIndex = -1
Dim $arrFile[$FileArraySize]
Dim $fso, $arrMask, $file, $filename, $filedata, $ext

If not $Dir Exit 1 EndIf
If not Exist($Dir) Exit 2 EndIf

If Right($Dir,1) <> "\"
$Dir = $Dir + '\'
EndIf

if $verbose $Dir+chr(13) endif

if $datatype=1
$fso = CreateObject("scripting.filesystemobject")
endif

If $mask = 0 $mask = "*.*" EndIf
$arrMask = Split($mask,";")
$file = Dir($Dir + "*.*")
While $file and (not @error)
if ($file <> ".") and ($file <> "..")
$filename = $dir + $file

$filedata = 0
if GetFileAttr($filename) & 16
;-- this is a directory --
if $SubFolders
; add the foldername to an array of subdir
$SubDirIndex = $SubDirIndex + 1
if $SubDirIndex > $SubDirSize
$SubDirSize = $SubDirSize + $SubDirSizeInc
$SubDirSizeInc = $SubDirSizeInc * 2
Redim preserve $arrSubDir[$SubDirSize]
endif
$arrSubDir[$SubDirIndex] = $file

if $datatype=1
$filedata = $fso.getfolder($filename)
endif
endif
else
;-- this is a file --
$ext = instrrev($filename,".")
if $ext
$ext = substr($filename,$ext)
if AScan($arrMask,$ext) <> -1
if $datatype=1
$filedata = $fso.getfile($filename)
else
$filedata = $filename
endif
endif
endif
endif
if $filedata <> 0
;-- add filename in the result array --
$FileArrayIndex = $FileArrayIndex + 1
if $FileArrayIndex > $FileArraySize
$FileArraySize = $FileArraySize + $FileArraySizeInc
$FileArraySizeInc = $FileArraySizeInc * 2
Redim preserve $arrFile[$FileArraySize]
endif
$arrFile[$FileArrayIndex] = $filename
endif
endif
$file = Dir("")
Loop

if $SubFolders
if $SubDirIndex > -1
;-- there are subdirs : scan subdir --
Redim preserve $arrSubDir[$SubDirindex]

dim $SubDir, $arrSubDirFiles
for each $SubDir in $arrSubDir
$arrSubDirFiles = DirPlus( $Dir+$SubDir, $mask, $SubFolders, $DataType, $verbose )

for each $file in $arrSubDirFiles
$FileArrayIndex = $FileArrayIndex + 1
if $FileArrayIndex > $FileArraySize
$FileArraySize = $FileArraySize + $FileArraySizeInc
$FileArraySizeInc = $FileArraySizeInc * 2
Redim preserve $arrFile[$FileArraySize]
endif
$arrFile[$FileArrayIndex] = $file
next
next
endif
endif

if $verbose RPad("",len($Dir)," ")+chr(13) endif

if $FileArrayIndex > -1
Redim preserve $arrFile[$FileArrayIndex]
$DirPlus = $arrFile
Exit 0
else
Exit 3
endif
EndFunction

function RPad( $str, $length, $char )
while len($str)<$length
$str = $str + $char
loop
$RPad = $str
endfunction

function LPad( $str, $length, $char )
while len($str)<$length
$str = $char + $str
loop
$LPad = $str
endfunction



without answer from @lejo @rias, DirPlus returns files and dirs with no use of FSO to scan a disk. FSO is used only if $datatype=1
_________________________
Christophe

Top
#126560 - 2004-09-13 03:49 PM Re: Array Problem
@lejo @rias Offline
Starting to like KiXtart

Registered: 2003-09-02
Posts: 100
Loc: Medellin, Colombia
Sorry srs, Iīm out from home in weekend.
Tkx 4 ur all answ.

This is the idea, I need read from all disks and/or partitions (not network) files office (.doc.xls.ppt.mdb) notes (.id.nsf) but with exeptions (readme.doc, db4lib.nsf, fileit.id, etc)

(This is for backup pruposes in my lan)

This is the script:

Code:

$objFSO = CreateObject("Scripting.FileSystemObject")
$Drives = $objFSO.Drives
For Each $Drive In $Drives
If $Drive.Drivetype = 2
$Origen=$Drive+"\temp" ; for test only, in the last version delete \temp
$ListaCompleta=DirPlus($Origen,$FileExt,1)
$Archivos=UnirArreglos($Archivos,$ListaCompleta)
EndIf
Next

$Exclusiones="DBLIB4.nsf","favorite.nsf","helplt4.nsf","iccon.nsf","log.nsf","lsxlc.nsf","perweb.nsf","readme.nsf,readme.doc"

For Each $Ex In $Exclusiones
$Archivos=FilterArray($archivos,$Ex)
Next

Function UnirArreglos($Array1, $Array2)
Dim $n,$i
$n = Ubound($Array1) + 1
ReDim PRESERVE $Array1[$n+Ubound($Array2)]
For $i = 0 to Ubound($Array2)
$Array1[$n+$i] = $Array2[$i]
Next
$UnirArreglos = $Array1
EndFunction

Function DirPlus($Dir,$mask,optional $subfolders, optional $datatype)
Dim $file, $subflag, $i, $ii,$pattern
If VarType($_temparray) = 0
Global $_temparray[30], $_i
$_i = 0
Else
$subflag = 1
EndIf
If $Dir = 0 Exit(1) EndIf
If SubStr($Dir,Len($Dir),1) = "\"
$Dir = SubStr($Dir,1,Len($Dir)-1)
EndIf
If $mask = 0
$mask = "*.*"
EndIf
$mask = Split($mask,";")
If Exist($Dir) = 0 Exit(2) EndIf
$file = Dir($Dir + "\*.*")
While @error = 0 AND $file
Select
Case $file = "." OR $file = ".."
;bit bucket!
Case GetFileAttr($Dir + "\" + $file) & 16
$_temparray[$_i] = $Dir + "\" + $file
$_i = $_i + 1
If $subfolders = 1
dirplus($Dir + "\" + $file,"*.*",$subfolders)
If @error <> 0 Exit(1) EndIf
EndIf
Case 1
$_temparray[$_i] = $Dir + "\" + $file
$_i = $_i + 1
EndSelect
If Ubound($_temparray) = $_i
ReDim preserve $_temparray[$_i + 30]
EndIf
$file = Dir("")
Loop

If $subflag = 1
;
Else
ReDim preserve $_temparray[$_i-1]
$dirplus = $_temparray
Select
Case $mask[0] = "*.*"
;return all files!
Case 1
Dim $temparray[Ubound($dirplus)]
$ii = 0
For Each $pattern In $mask
$i = 0
For Each $file In $dirplus
If InStr($file,$pattern)
$temparray[$ii] = $dirplus[$i]
$ii = $ii + 1
EndIf
$i = $i + 1
Next
Next
If $ii > 0
ReDim preserve $temparray[$ii-1]
$dirplus = $temparray
Else
$dirplus = 0
EndIf
EndSelect
Select
Case $datatype = 0
;return filename!
Case $datatype = 1
;return File object handle
$i = 0
$fso = CreateObject("scripting.filesystemobject")
If @error <> 0 AND VarType($fso) <> 9 Exit(@errro) EndIf
For Each $file In $dirplus
If GetFileAttr($file) & 16
$file = $fso.getfolder($file)
Else
$file = $fso.getfile($file)
EndIf
$dirplus[$i] = $file
$i = $i + 1
Next
EndSelect
$_i = 0
$_temparray = 0
Exit(0)
EndIf
EndFunction

Function FilterArray($array,$find, optional $inclusive)
Dim $lf, $t, $l, $sp
$lf=Chr(10) $sp=Chr(32)
If NOT VarType($Array) & 8192 Exit(1) EndIf
For Each $l In $array
If (InStr($l,$find) AND $inclusive AND Trim($l)> $sp)
OR (NOT InStr($l,$find) AND NOT $inclusive AND Trim($l)> $sp)
$t=$t+$lf+$l
EndIf
Next
$FilterArray=Split(SubStr($t,2),$lf)
EndFunction



All UDF from kixhelp.com

This array returned ($archivos) I use to backup all them in a $target directory... (the user may add or delete another files but the full script is not ready...)


Edited by @lejo @rias (2004-09-13 04:03 PM)
_________________________
Look always 4 the best...

Top
#126561 - 2004-09-13 05:05 PM Re: Array Problem
ChristopheM Offline
Hey THIS is FUN
*****

Registered: 2002-05-13
Posts: 311
Loc: STRASBOURG, France
with the example I have posted, you should apply the filter to the file name,
not to the array and backup the file immediatly (or write the file name in a data file).

So you haven't to maintain a very big array with all files
but just the array for the current disk you scan.

In your last function, you concatenate files name in a string and then split the string.
Be careful that strings are limited to 32000 characters. With a large tree, you could have problems due to this limitation.

_________________________
Christophe

Top
#126562 - 2004-09-13 05:52 PM Re: Array Problem
@lejo @rias Offline
Starting to like KiXtart

Registered: 2003-09-02
Posts: 100
Loc: Medellin, Colombia
Tkx Chr, the script work fine with ur UDF
I donīt know much on programming, Iīm Dummy, this is the full code until now, but still working... and learnig...

(Req: kixforms.dll 2.3.0 Final)

Code:
 

SetConsole("hide")
Break On

; Hide Files not copied

If Exist("N:\RENOVACI\DATOS.INI")
$FileExt=ReadProfileString("N:\RENOVACI\DATOS.INI","VALORES","FILEXT")
$Destino=ReadProfileString("N:\RENOVACI\DATOS.INI","VALORES","DESTINO")
$Exclusiones=ReadProfileString("N:\RENOVACI\DATOS.INI","VALORES","EXCLUSIONES")
Else
$=MessageBox("Imposible abrir el archivo con los datos para realizar el backup, se continuara con los datos basicos","Informacion",48,15)
$FileExt=".doc;.xls;.ppt;.zip;.nsf"
$Destino="C:\TEST" ;EL DEFINITIVO SERA "F:\BACKUP\"
If Right($Destino,1)<>"\" $Destino=$Destino+"\" EndIf
$Exclusiones="DBLIB4.nsf","favorite.nsf","helplt4.nsf","iccon.nsf","log.nsf","lsxlc.nsf","perweb.nsf","readme.nsf"
EndIf

$Destino=$Destino+@WKSTA

$System = CreateObject("Kixtart.System")
$FORM = CreateObject("Kixtart.FORM")

$FORM.CAPTION = "Resplaldo Archivos Renovacion Tecnologica"
$FORM.SCALEHEIGHT = 402
$FORM.SCALEWIDTH = 600
$FORM.FONTNAME = "Arial"
$FORM.FONTSIZE = 9
$FORM.ICON = $System.BuiltinIcons(51)

$fraBanner = $FORM.PictureBox
$fraBanner.BACKCOLOR = $FORM.RGB(255,255,255)
$fraBanner.HEIGHT = 70
$fraBanner.Left = 10
$fraBanner.TOP = 10
$fraBanner.WIDTH = 585

$picBanner = $fraBanner.Image
$picBanner.Picture = "shell32.dll;23"
$picBanner.HEIGHT = 60
$picBanner.Left = 5
$picBanner.TOP = 5
$picBanner.WIDTH = 60

$fraDetails = $FORM.Frame("Detalles")
$fraDetails.HEIGHT = 300
$fraDetails.Left = 8
$fraDetails.TOP = 95
$fraDetails.WIDTH = 585

$fraTotales = $FORM.Frame("Totales")
$fraTotales.TOP = 280
$fraTotales.HEIGHT = 50
$fraTotales.Left = 11
$fraTotales.WIDTH = 579

; Dibujar Banner

$fraBanner.FONTSIZE = 20
$fraBanner.FONTNAME = "verdana"
$fraBanner.ForeColor = 0
$fraBanner.PrintXY(70,0,"Respaldo de Informacion")
$fraBanner.FONTSIZE = 8
$fraBanner.ForeColor = $FORM.RGB(0,100,100)
$fraBanner.PrintXY(73,32,"Gerencia de Redes Locales")
$fraBanner.FONTBOLD = 1
$fraBanner.FONTSIZE = 11
$fraBanner.PrintXY(273,46,"Bienvenido")
$fraBanner.FONTBOLD = 0
$fraBanner.FONTSIZE = 10

; Forma de Lista de archivos

$List = $Form.ListView
$List.Top = 115
$List.Left = 15
$List.Width = 570
$List.Height = 150
$List.MultiSelect = 1
$List.OnDoubleClick = "Delete_Click()"
$List.Sorted = 2 ; Yes, sort the first column
$List.MultiSelect = True ; Allow more than one selection
$List.GridLines = True ; Show gridlines in report view
$List.FullRowSelect = True ; Allow user to select the entire row

$FileName = $List.Columns.Add
$FileName.FontSize = 12
$FileName.Text = "Nombre"
$FileName.Width = (355)

$FileSize = $List.Columns.Add
$FileSize.Text = "Tamaņo"
$FileSize.Width = (65)
$FileSize.Alignment = 1

$FileDate = $List.Columns.Add
$FileDate.Text = "Fecha"
$FileDate.Width = (125)
$FileDate.Alignment = 1

;************* Salir **************
$Salir = $Form.ToolButton
$Salir.Enabled = "True"
$Salir.FlatStyle = 2
$Salir.Left = 495
$Salir.Text = "Salir"
$Salir.Top = 355
$Salir.Visible = "True"
$Salir.Width = 75
$Salir.Icon = 60
$Salir.FontSize = 7
$Salir.Onclick = "quit()"
;**********************************

;************* Procesar ***********
$Procesar = $Form.ToolButton
$Procesar.Enabled = "True"
$Procesar.FlatStyle = 2
$Procesar.Left = 30
$Procesar.Text = "Procesar"
$Procesar.Top = 355
$Procesar.Visible = "True"
$Procesar.Width = 75
$Procesar.Icon = 10
$Procesar.FontSize = 7
$Procesar.Onclick = "OnButtonClick()"
;**********************************

;************* Examinar ***********
$Examinar = $Form.ToolButton("Browse...")
$Examinar.Enabled = "True"
$Examinar.FlatStyle = 2
$Examinar.Left = 230
$Examinar.Text = "Adicionar"
$Examinar.Top = 355
$Examinar.Visible = "True"
$Examinar.Width = 75
$Examinar.Icon = 1
$Examinar.FontSize = 7
$Examinar.Onclick = "$$nul = BrowseForFile_Click()"
;**********************************

;************* Eliminar ***********
$Eliminar = $Form.ToolButton
$Eliminar.Enabled = "True"
$Eliminar.FlatStyle = 2
$Eliminar.Left = 310
$Eliminar.Text = "Remover"
$Eliminar.Top = 355
$Eliminar.Visible = "True"
$Eliminar.Width = 75
$Eliminar.Icon = 44
$Eliminar.FontSize = 7
$Eliminar.OnClick = "Delete_Click()"
;**********************************

$objFSO = CreateObject("Scripting.FileSystemObject")
$Drives = $objFSO.Drives
For Each $Drive In $Drives
If $Drive.Drivetype = 2
$Origen=$Drive+"\temp" ; Eliminar +"\temp" en la ver final
$ListaCompleta=DirPlus($Origen,$FileExt,1)
$Archivos=UnirArreglos($Archivos,$ListaCompleta)
EndIf
Next

For Each $Ex In $Exclusiones
$Archivos=FilterArray($archivos,$Ex)
Next

For Each $File In $Archivos
$ItemFile = $List.Items.Add
$ItemFile.SubItems(0).Text = "$File"
$ItemFile.SubItems(1).Text = GetFileSize("$File")
$ItemFile.SubItems(2).Text = GetFileTime("$File")
$tam=$tam+GetFileSize($file)
Next

$lblTotales = $FORM.Label
$lblTotales.CAPTION = "Cantidad Archivos"
$lblTotales.HEIGHT = 20
$lblTotales.WIDTH = 110
$lblTotales.Left = 90
$lblTotales.TOP = 301

$totalarchivos = $FORM.TextBox
$totalarchivos.HEIGHT = 19
$totalarchivos.Left = $lblTotales.Left+110
$totalarchivos.TOP = 300
$totalarchivos.TextAlign = 1
$tac=$List.Items.Count
$totalarchivos.Text = $tac
$totalarchivos.WIDTH = 40

$lblTotalTa = $FORM.Label
$lblTotalTa.CAPTION = "Total Espacio en disco"
$lblTotalTa.HEIGHT = 20
$lblTotalTa.WIDTH = 140
$lblTotalTa.Left = $totalarchivos.Left+80
$lblTotalTa.TOP = 301

$totalarchivosTa = $FORM.TextBox
$totalarchivosTa.HEIGHT = 20
$totalarchivosTa.Left = $lblTotalTa.Left+140
$totalarchivosTa.TOP = 300
$totalarchivosTa.TextAlign = 1
$totalarchivosTa.Text = $tam
$totalarchivosTa.WIDTH = 80

$lblMegabytes = $FORM.Label
$lblMegabytes.CAPTION = "Bytes"
$lblMegabytes.HEIGHT = 20
$lblMegabytes.WIDTH = 60
$lblMegabytes.Left = $totalarchivosTa.Left+80
$lblMegabytes.TOP = 301

$FORM.Center
$FORM.Show

$List.SetFocus

While $FORM.Visible
$=Execute($FORM.DoEvents)
Loop

Exit 1

Function OnButtonClick()
$c=1
$t=$List.Items.Count
For Each $Item In $List.Items
$String = $Item.Text
$Wait = CreateObject("Kixtart.FORM")
$Wait.FONTSIZE = 14
$Wait.FONTNAME = "Arial"
$Wait.PrintXY(25,35,"Realizando Backup, espere un momento por favor... $c de $t")
$Wait.FONTSIZE = 10
$Wait.PrintXY(25,65,"$String")
$Wait.CENTER
$Wait.Icon = $System.BuiltinIcons(7)
$Wait.CAPTION = "Backup..."
$Wait.SCALEWIDTH = 550
$Wait.SCALEHEIGHT = 100
$Wait.Show
$an=Left($string,1)
$string="disco_"+$an+SubStr($string,3,1000)
$cutpath=getfilepath($String,1)
$acu=$destino
For Each $element In $cutpath
$acu=$acu+"\"+$element
If NOT Exist($acu) MD $acu EndIf
Next
$Orig=$Item.Text
$Dest=$Destino+"\"+$String
$Desti=getfilepath($Dest)
GUICopy($orig, $Desti,4) ;Para mover con GUICopy("c:\origen", "E:\",0,1)
If $c=$t $Wait.Hide EndIf
$c=$c+1
Next
EndFunction

Function BrowseForFile_Click()
Dim $f
$f = $form.Dialogs.OpenFileDialog
$f.Filter = "Todos los Archivos (*.*)|*.*|Microsoft Word (*.doc)|*.doc|Microsoft Excel (*.xls)|*.xls|Microsoft Powerpoint (*.ppt)|*.ppt|Lotus Notes - Base de datos (*.nsf)|*.nsf|Lotus Notes - ID (*.id)|*.id"
If $f.ShowDialog = 1
$BrowseForFile_Click = $f.Filename
EndIf
If $BrowseForFile_Click
For Each $Item In $List.Items
$String = $Item.Text
If InStr($String,$BrowseForFile_Click)
MessageBox("El archivo seleccionado ya aparece en el listado","Seņor Usuario",48)
$Item.Selected = 1
$List.SetFocus
Return
EndIf
Next
$tac=$List.Items.Count+1
$tam=$tam+GetFileSize($BrowseForFile_Click)
$totalarchivos.Text = $tac
$totalarchivosTa.Text = $tam
$ItemFile = $List.Items.Add
$ItemFile.SubItems(0).Text = $BrowseForFile_Click
$ItemFile.SubItems(1).Text = GetFileSize($BrowseForFile_Click)
$ItemFile.SubItems(2).Text = GetFileTime($BrowseForFile_Click)
$List.SetFocus
EndIf
EndFunction

Function Delete_Click()
If $Form.MsgBox("Esta seguro que desea eliminar los elementos seleccionados del listado?","Borrar",4) = 6
$Form.MousePointer = 11
$Form.Enabled = 0
$Form.BeginUpdate
$List.SelectedItems.Clear
$Form.EndUpdate
$Form.MousePointer = 0
$Form.Enabled = 1
$tacd=0
$tamd=0
For Each $Item In $List.Items
$tacd=$tacd+1
$tamd=$tamd+GetFileSize($Item.Text)
Next
$tac=$tacd
$tam=$tamd
$totalarchivos.Text = $tac
$totalarchivosTa.Text = $tam
$List.SetFocus
Return
EndIf
EndFunction

Function GUICopy($sSrc, $sDest, OPTIONAL $lFlags, OPTIONAL $bMove)
Dim $sVer,$objShell,$objFldr
If NOT Exist($sSrc) Exit 2 EndIf
If NOT Exist($sDest) Exit 3 EndIf
If @INWIN=1
$sVer=GetFileVersion(%WINDIR%+"\System32\Shell32.dll","FileVersion")
Else
$sVer=GetFileVersion(%WINDIR%+"\System\Shell32.dll","FileVersion")
EndIf
If $sVer<"4.71" Exit 10 EndIf
$objShell=CreateObject("Shell.Application")
$objFldr=$objShell.NameSpace($sDest)
If @ERROR<0 Exit Val("&"+Right(DecToHex(@ERROR),4)) EndIf
Select
Case $bMove=1 $objFldr.MoveHere($sSrc,$lFlags)
Case $bMove=0 $objFldr.CopyHere($sSrc,$lFlags)
Case 1 Exit 87
EndSelect
If @ERROR<0 Exit Val("&"+Right(DecToHex(@ERROR),4)) EndIf
Exit @ERROR
EndFunction

Function getfilepath($filespec, optional $seg)
If InStr($filespec,'\')
$getfilepath=Split($filespec,'\')
ReDim preserve $getfilepath[Ubound($getfilepath)-1]
If NOT Val($seg)
$getfilepath=Join($getfilepath,'\')
EndIf
Else
$getfilepath=''
EndIf
EndFunction

Function UnirArreglos($Array1, $Array2)
Dim $n,$i
$n = Ubound($Array1) + 1
ReDim PRESERVE $Array1[$n+Ubound($Array2)]
For $i = 0 to Ubound($Array2)
$Array1[$n+$i] = $Array2[$i]
Next
$UnirArreglos = $Array1
EndFunction

Function FilterArray($array,$find, optional $inclusive)
Dim $lf, $t, $l, $sp
$lf=Chr(10) $sp=Chr(32)
If NOT VarType($Array) & 8192 Exit(1) EndIf
For Each $l In $array
If (InStr($l,$find) AND $inclusive AND Trim($l)> $sp)
OR (NOT InStr($l,$find) AND NOT $inclusive AND Trim($l)> $sp)
$t=$t+$lf+$l
EndIf
Next
$FilterArray=Split(SubStr($t,2),$lf)
EndFunction

Function DirPlus($Dir, $mask, optional $subfolders, optional $datatype, optional $verbose)
Dim $SubDirIndex, $SubDirSize, $SubDirSizeInc
$SubDirSize = 0
$SubDirSizeInc = 16
$SubDirIndex = -1
Dim $arrSubdir[$SubDirSize]

Dim $FileArrayIndex, $FileArraySize, $FileArraySizeInc
$FileArraySize = 0
$FileArraySizeInc = 16
$FileArrayIndex = -1
Dim $arrFile[$FileArraySize]
Dim $fso, $arrMask, $file, $filename, $filedata, $ext

If NOT $Dir Exit 1 EndIf
If NOT Exist($Dir) Exit 2 EndIf

If Right($Dir,1) <> "\"
$Dir = $Dir + '\'
EndIf

If $verbose $Dir+Chr(13) EndIf

If $datatype=1
$fso = CreateObject("scripting.filesystemobject")
EndIf

If $mask = 0 $mask = "*.*" EndIf
$arrMask = Split($mask,";")
$file = Dir($Dir + "*.*")
While $file AND (NOT @error)
If ($file <> ".") AND ($file <> "..")
$filename = $Dir + $file

$filedata = 0
If GetFileAttr($filename) & 16
;-- this is a directory --
If $SubFolders
; add the foldername to an array of subdir
$SubDirIndex = $SubDirIndex + 1
If $SubDirIndex > $SubDirSize
$SubDirSize = $SubDirSize + $SubDirSizeInc
$SubDirSizeInc = $SubDirSizeInc * 2
ReDim preserve $arrSubDir[$SubDirSize]
EndIf
$arrSubDir[$SubDirIndex] = $file

If $datatype=1
$filedata = $fso.getfolder($filename)
EndIf
EndIf
Else
;-- this is a file --
$ext = InStrRev($filename,".")
If $ext
$ext = SubStr($filename,$ext)
If AScan($arrMask,$ext) <> -1
If $datatype=1
$filedata = $fso.getfile($filename)
Else
$filedata = $filename
EndIf
EndIf
EndIf
EndIf
If $filedata <> 0
;-- add filename in the result array --
$FileArrayIndex = $FileArrayIndex + 1
If $FileArrayIndex > $FileArraySize
$FileArraySize = $FileArraySize + $FileArraySizeInc
$FileArraySizeInc = $FileArraySizeInc * 2
ReDim preserve $arrFile[$FileArraySize]
EndIf
$arrFile[$FileArrayIndex] = $filename
EndIf
EndIf
$file = Dir("")
Loop

If $SubFolders
If $SubDirIndex > -1
;-- there are subdirs : scan subdir --
ReDim preserve $arrSubDir[$SubDirindex]

Dim $SubDir, $arrSubDirFiles
For Each $SubDir In $arrSubDir
$arrSubDirFiles = DirPlus( $Dir+$SubDir, $mask, $SubFolders, $DataType, $verbose )

For Each $file In $arrSubDirFiles
$FileArrayIndex = $FileArrayIndex + 1
If $FileArrayIndex > $FileArraySize
$FileArraySize = $FileArraySize + $FileArraySizeInc
$FileArraySizeInc = $FileArraySizeInc * 2
ReDim preserve $arrFile[$FileArraySize]
EndIf
$arrFile[$FileArrayIndex] = $file
Next
Next
EndIf
EndIf

If $verbose RPad("",Len($Dir)," ")+Chr(13) EndIf

If $FileArrayIndex > -1
ReDim preserve $arrFile[$FileArrayIndex]
$DirPlus = $arrFile
Exit 0
Else
Exit 3
EndIf
EndFunction

_________________________
Look always 4 the best...

Top
Page 1 of 1 1


Moderator:  Jochen, Allen, Radimus, Glenn Barnas, ShaneEP, Ruud van Velsen, Arend_, Mart 
Hop to:
Shout Box

Who's Online
1 registered (Allen) and 271 anonymous users online.
Newest Members
Sir_Barrington, batdk82, StuTheCoder, M_Moore, BeeEm
17886 Registered Users

Generated in 0.068 seconds in which 0.024 seconds were spent on a total of 12 queries. Zlib compression enabled.

Search the board with:
superb Board Search
or try with google:
Google
Web kixtart.org