#define WIN_INCLUDEALL
#Include Once "dir.bi"
#Include Once "windows.bi"
#Include Once "win\shlobj.bi"
#Include Once "win\commdlg.bi"

/'
SrvFlushPhysicalMem()
RunProcess (path)
FileSaveDialog (filename,hwnd ,title,dir)
FileOpenDialog (hwnd,title,dir,filter)
FileSelectFolder (hwnd,title,flags)
DeleteFullDir (Dir)
fbRGB (Red,Green,Blue)
'/


Dim Shared As String CRLF
CRLF = Chr(13,10)

Declare Function StrReplace(Byref haystack As String, Byref needle1 As String, Byref needle2 As String) As String
Declare Function StrSplit(src As String,del As String,res() As String) As Integer
Declare Sub RunProcess(path As String)
Declare Sub SrvFlushPhysicalMem()
Declare Function FileSaveDialog (ByRef ifilename As String = "", ByRef hwnd As HWND = NULL ,Byref ititle As String = "请选择文件保存地址", Byref idir As String = CurDir) As String
Declare Function FileOpenDialog (ByRef hwnd As HWND = NULL ,Byref ititle As String = "请选择一个文件", Byref idir As String = CurDir, ByRef filter As String = "All(*.*)\0*.*\0\0") As String
Declare Function FileSelectFolder (ByRef hwnd As HWND = HWND_DESKTOP, Byref title As String = "请选择一个文件夹", ByRef flags As UINT = 0) As String
Declare Function DeleteFullDir (ByRef DirName As String ) As Integer
Declare Function fbRGB (ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer) As Integer

Function StrReplace(Byref haystack As String, Byref needle1 As String, Byref needle2 As String) As String
	
	Dim As Integer len1 = Len(needle1), len2 = Len(needle2)
	Dim As Integer i
	
	Dim As String haystack_ = haystack
	
	i = Instr(haystack_, needle1)
	While i
		
		haystack_ = Left(haystack_, i - 1)& needle2 & Mid(haystack_, i + len1)
		
		i = Instr(i + len2, haystack_, needle1)
		
	Wend
	
	Function = haystack_
    
End Function

Function StringSplit(src As String,del As String,res() As String) As Integer

	Const MAXDELIMITERS = 256        
        
	Dim As Integer char, d, i, s, l
	Dim As Integer delpos(0 To MAXDELIMITERS+1)
	
	char = Asc( del )
	
	'' find all delimiters
	d = 0
	delpos(d) = 0
	For i = 0 To Len( src )-1
		If src[i] = char Then 
			d += 1
			If( d > MAXDELIMITERS ) Then
			        Exit For
			End If
			delpos(d) = i + 1
		End If
	Next
	
	'' allocate the result array
	Redim res(0 To d)
	
	If( d = 0 ) Then
		res(0) = src
		Return 1
	End If
	       
	'' copy strings
	delpos(d+1) = Len( src ) + 1
	For i = 0 To d
		
		s = delpos(i) + 1
		l = delpos(i+1) - s
		If( l > 0 ) Then
		      res(i) = Mid$( src, s, l )
		End If
		
	Next
	
	Function = d + 1
        
End Function

Function FileSaveDialog (ByRef ifilename As String = "", ByRef hwnd As HWND = NULL ,Byref ititle As String = "请选择文件保存地址", Byref idir As String = CurDir) As String
  Dim ofn As OPENFILENAME
  Dim filename As Zstring * (MAX_PATH + 1) => ifilename
  Dim title As Zstring * 32 => ititle
  Dim initialdir As Zstring * 256 => idir
  
  With ofn
    .lStructSize       = Sizeof(OPENFILENAME)
    .hwndOwner         = hwnd
    .hInstance         = GetModuleHandle(NULL)
    .lpstrFilter       = NULL
    .lpstrCustomFilter = NULL
    .nMaxCustFilter    = 0
    .nFilterIndex      = 1
    .lpstrFile         = @filename
    .nMaxFile          = Sizeof(filename)
    .lpstrFileTitle    = NULL
    .nMaxFileTitle     = 0
    .lpstrInitialDir   = @initialdir
    .lpstrTitle        = @title
    .Flags             = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
    .nFileOffset       = 0
    .nFileExtension    = 0
    .lpstrDefExt       = NULL
    .lCustData         = 0
    .lpfnHook          = NULL
    .lpTemplateName    = NULL
  End With

  If (GetSaveFileName(@ofn) = FALSE) Then Return ""
  Return filename
End Function

Function FileOpenDialog (ByRef hwnd As HWND = NULL ,Byref ititle As String = "请选择一个文件", Byref idir As String = CurDir, ByRef filter As String = "All(*.*)\0*.*\0\0") As String
  Dim ofn As OPENFILENAME
  Dim filename As Zstring * (MAX_PATH + 1)
  Dim title As Zstring * 32 => ititle
  Dim initialdir As Zstring * 256 => idir
  
  With ofn
    .lStructSize       = Sizeof(OPENFILENAME)
    .hwndOwner         = hwnd
    .hInstance         = GetModuleHandle(NULL)
    .lpstrFilter       = Strptr(filter)
    .lpstrCustomFilter = NULL
    .nMaxCustFilter    = 0
    .nFilterIndex      = 1
    .lpstrFile         = @filename
    .nMaxFile          = Sizeof(filename)
    .lpstrFileTitle    = NULL
    .nMaxFileTitle     = 0
    .lpstrInitialDir   = @initialdir
    .lpstrTitle        = @title
    .Flags             = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
    .nFileOffset       = 0
    .nFileExtension    = 0
    .lpstrDefExt       = NULL
    .lCustData         = 0
    .lpfnHook          = NULL
    .lpTemplateName    = NULL
  End With

  If (GetOpenFileName(@ofn) = FALSE) Then Return ""
  Return filename
End Function

Function FileSelectFolder (ByRef hwnd As HWND = HWND_DESKTOP, Byref title As String = "请选择一个文件夹", ByRef flags As UINT = 0) As String
  Dim bi As BROWSEINFO
  Dim pidl As LPITEMIDLIST
  Dim ret As HRESULT
  Dim physpath As Zstring * MAX_PATH
  Dim dispname As Zstring * MAX_PATH
  
  bi.hwndOwner = hwnd
  ret = SHGetSpecialFolderLocation(hwnd, CSIDL_DRIVES, @bi.pidlRoot)
  
  bi.pszDisplayName = @dispname
  bi.lpszTitle = Strptr(title)
  bi.ulFlags = flags
  bi.lpfn = 0
  bi.lParam = 0
  bi.iImage = 0
  
  pidl = SHBrowseForFolder(@bi)
  
  If pidl <> 0 Then
    If SHGetPathFromIDList(pidl, physpath) = 0 Then
      Function = ""
    Else
      Function = physpath
    End If
    CoTaskMemFree pidl
  Else
    Function = ""
  End If
  
  CoTaskMemFree bi.pidlRoot
End Function


Sub RunProcess(path As String)
	Dim As Integer res
	'
	Dim As PROCESS_INFORMATION pi
	Dim As STARTUPINFO si
	si.dwFlags=STARTF_USESHOWWINDOW  'this is required for:
	si.wShowWindow=SW_SHOWNOACTIVATE ' "or" these if multiple
	si.cb=Len(si)
	
	res=CreateProcess(_
	NULL,_ 'this param doesn't work consistently, use:
	path,_ 'complete path and quote as needed
	NULL,_
	NULL,_
	NULL,_
	NORMAL_PRIORITY_CLASS,_ 'set priority here, #6..
	NULL,_
	NULL,_
	@si,_
	@pi)
End Sub

Function DeleteFullDir (Byref DirName As String) As Integer
     'SHFileOperation
     Dim result As Integer
     Dim As String nextdirname ,filename

     filename  = Dir( DirName & "\*", (fbReadOnly Or fbHidden Or fbSystem Or fbArchive) )
    
     While Len( filename ) > 0
       Kill DirName & "\" & filename
       filename = Dir( )
     Wend
    
     result = Rmdir (DirName)
    
     If result = -1 Then
       nextdirname = Dir( DirName & "\*", fbDirectory )
       Do
         If nextdirname <> "." And nextdirname <> ".." Then
              DeleteFullDir ( DirName & "\" & nextdirname )
              nextdirname = Dir( DirName & "\*", fbDirectory )
         Else
           nextdirname = Dir()
         End If
       Loop While Len( nextdirname ) > 0
     Endif
    
     Return 0
End Function

Sub SrvFlushPhysicalMem()
  
  SetLastError(NO_ERROR)
  
  Dim hProc   As HANDLE
  Dim dwMin   As Uinteger
  Dim dwMax   As Uinteger
  Dim ret     As Integer
  
  'Flush the process memory into the page file..
  
  'Obtain a handle for the current process
  hProc = OpenProcess(PROCESS_SET_QUOTA Or PROCESS_QUERY_INFORMATION, FALSE, GetCurrentProcessId())
  
  If hProc = INVALID_HANDLE_VALUE Then 
      'Couldn't open a handle to the current process..
      'Just abort.. 
      ret = FALSE
  Else
      'Get the current working set size..
      If GetProcessWorkingSetSize(hProc, @dwMin, @dwMax) = FALSE Then
          'Could not get the current values, assume defaults
          dwMin = 204800  'default (~ 400KB)
          dwMax = 1413120 'default (~ 2MB)
      End If
      
      'Flush the process' physical memory..
      If SetProcessWorkingSetSize(hProc, cuint(-1), cuint(-1)) = FALSE Then        
          ret = FALSE
      Else
          ret = TRUE
      End If
      
      'Restore old values..
      If SetProcessWorkingSetSize(hProc, dwMin, dwMax) = FALSE Then        
          ret = FALSE
      End If
      
      'Close the handle
      CloseHandle(hProc)
  End If
  
  SetLastError(NO_ERROR)
   
End Sub

Function fbRGB (ByRef Red As Integer, ByRef Green As Integer, ByRef Blue As Integer) As Integer
	Return CLng(Red + (Green * 256) + (Blue * 65536))
End Function