'-------------------- LIBRARIE PENTRU FUNCTII COMUNE VB SCRIPT --------------------
'---------- ODMA ----------
Function isInArray(arr, valueS, l, u)
	isInArray=False
	Dim i 
	For i=l To u
		If(arr(i)=valueS)Then
			isInArray=True
			Exit Function
		End If
	Next
End Function
Function writeODMA(strODMA, strFile)
	Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
	'Create text stream object
	Dim TextStream
	strFileName=""
	hasB=false
	hasA=false
	Dim i
	For i=Len(strFile) To 1 Step -1
		If(Mid(strFile,i,1)<>"\")Then
			strFileName=Mid(strFile,i,1)+strFileName
		Else
			i=0
		End If
	Next
	winFolder=FS.GetSpecialFolder(0)
	If Not FS.FileExists (WinFolder+"\ODMASAMP.INI") Then
		Exit Function
	End If
	Set iStream = FS.OpenTextFile(WinFolder+"\ODMASAMP.INI",1)
	ReDim arIDS(0)
	lastId=-1
	l=0
	do while istream.AtEndOfStream <> true
	    contents = istream.Readline
		If(contents="["+strODMA+"]")Then
			hasB=true
		End If
		If(contents=(strODMA+"="))Then
			hasA=true
		End If
		If((Len(contents)=49) And(Mid(contents, 49,1)="="))Then
			lastId=lastId+1
			ReDim Preserve arrIDS(lastID)	
			arrIDS(lastId)="["+Mid(contents,1,48)+"]"
	'		MsgBox arrIDS(lastID)
		End If
	loop
	u=lastID
	istream.close
	If(hasA)Then
		Exit Function
	End If
	hasDocList=False
	Set TextStream = FS.OpenTextFile(winFolder+"\ODMASAMP.INI",1)
	FS.CopyFile winFolder+"\ODMASAMP.INI" , winFolder+"\_ODMASAMP.INI"
	Set cStream = FS.OpenTextFile(winFolder+"\_ODMASAMP.INI",2)
	hasSect=false
      
	do while textstream.AtEndOfStream <> true
		contents = textstream.Readline
		If(contents<>"[DocList]")Then
			If((Mid(contents,1,1)="[")And(Mid(contents,50,1)="]") and((Not (isInArray(arrIDS, contents,l,u)))))Then		' is section start
	'			MsgBox "Not in list "+contents+" ; skip 6 lines"
				If(contents=("["+strODMA+"]"))Then
					hasB=false
				End If
				For i=1 to 6
					contents=textstream.Readline
				Next
			Else
				cStream.WriteLine(contents)
			End If
		Else
			hasDocList=True
			If(Not (hasB))Then
				hasB=True
				cStream.WriteLine "["+strODMA+"]"
				cStream.WriteLine("Author=Default")
				cStream.WriteLine("Name="+strFileName)
				cStream.WriteLine("DocType=Default")
				cStream.WriteLine("Components=1")
				cStream.WriteLine("Format0=Text")
				cStream.WriteLine("DocLocation0="+StrFile)
			End If
			cStream.WriteLine(contents)		
		End If
	loop
	If(Not (hasB))Then
		hasB=True
		cStream.WriteLine "["+strODMA+"]"
		cStream.WriteLine("Author=Default")
		cStream.WriteLine("Name="+strFileName)
		cStream.WriteLine("DocType=Default")
		cStream.WriteLine("Components=1")
		cStream.WriteLine("Format0=Text")
		cStream.WriteLine("DocLocation0="+StrFile)
	End If
	If(not hasDocList)Then
		cStream.WriteLine("[DocList]")
	End If
	CStream.Write(strODMA+"=")
	TextStream.close
	cStream.close
	fs.DeleteFile winFolder+"\ODMASAMP.INI"
	fs.MoveFile winFolder+"\_ODMASAMP.INI", winFolder+"\ODMASAMP.INI"
End Function
Function SaveBinaryDataTextStream(FileName, ByteArray)
	'Create FileSystemObject object
	Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
	'  MsgBox "Begin SaveBinaryDataTextStream"
	'Create text stream object
	Dim TextStream
	Set TextStream = FS.CreateTextFile(FileName)
	'  MsgBox "SaveBinaryDataTextStream end create textfile"  
	'Convert binary data To text And write them To the file
	TextStream.Write BinaryToString(ByteArray)
	'MsgBox "SaveBinaryDataTextStream Final"  
End Function
Function BinaryToString(xBinary)
	'Antonin Foller, http://www.motobit.com
	'RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
	'to a string (BSTR) using ADO recordset
	Dim Binary
	'MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
	If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
	Dim RS, LBinary
	Const adLongVarChar = 201
	Set RS = CreateObject("ADODB.Recordset")
	LBinary = LenB(Binary)
  
	If LBinary>0 Then
		RS.Fields.Append "mBinary", adLongVarChar, LBinary
		RS.Open
		RS.AddNew
		RS("mBinary").AppendChunk Binary 
		RS.Update
		BinaryToString = RS("mBinary")
	Else
		BinaryToString = ""
	End If
End Function
Function BinaryGetURL(URL)
	'Create an Http object, use any of the four objects
	Dim Http
	'  Set Http = CreateObject("Microsoft.XMLHTTP")
	'  Set Http = CreateObject("MSXML2.ServerXMLHTTP")
	  Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
	'  Set Http = CreateObject("WinHttp.WinHttpRequest")
  
	'  MsgBox "Begin Binarygeturl"
  
	'Send request To URL
	strUser="Anonymous"
	strPass=""
	Http.Open "GET", url+"?login&UserName="+strUser+"&Password="+strPass, False
	Http.Send
  
	Http.Open "GET", URL, False
	Http.Send
	'  MsgBox "End Binarygeturl"
	'Get response data As a string
	BinaryGetURL = Http.ResponseBody
End Function
Function savefile(strFile, url)
On Error Resume Next
	savefile=false
	Set fs = CreateObject("Scripting.FileSystemObject")
	if(fs.FileExists(strFile))Then
	'	MsgBox "Begin delete copy"
		fs.DeleteFile(strFile)
		If(Err.number<>0)Then
		MsgBox "Eroare! Documentul este deja deschis in editare local: "+strFile
		On Error Goto 0
				Exit Function
		End If
	End If
	'MsgBox "Begin save"
	SaveBinaryDataTextStream strFile, BinaryGetURL(url)
	'MsgBox "End save"
	savefile=true
End Function
Function getExtensionApp(strExt)
	Dim wsh
	Set wsh=CreateObject("WScript.Shell")
	strRegKey="HKEY_CLASSES_ROOT\"+strExt+"\"
	strDef= wsh.RegRead(strRegKey)
	strDefShell=wsh.RegRead("HKEY_CLASSES_ROOT\"+strDef+"\shell\Open\command\")
	n=Instr(strDefShell,"%")
	If(n>0)Then
		strDefShell=Mid(strDefShell,1,n-1)
	End If
	n=Instr(strDefShell,"/")
	If(n>0)Then
		strDefShell=Mid(strDefShell,1,n-1)
	End If
	If(Len(strDefShell)>1)Then
		while((Mid(strDefShell,Len(strDefShell),1)=" ") or(Mid(strDefShell,Len(strDefShell),1)=""""))
			strDefShell=Mid(strDefShell, 1, Len(strDefShell)-1)
		Wend
		If((Mid(strDefShell,1,1)="""") And(Mid(strDefShell,Len(strDefShell),1)<>""""))Then
			strDefShell=strDefShell+""""
		End If
	End If
	getExtensionApp=strDefShell
End Function
function getLaunchLine(strFile)
	Dim wsh
	strExt=Right(strFile,5)
	nStart=Instr(strExt,".")
	If(nStart>0)Then
		strExt=Mid(strExt, nStart)
	End If
	Set wsh=CreateObject("WScript.Shell")
	strRegKey="HKEY_CLASSES_ROOT\"+strExt+"\"
	strDef= wsh.RegRead(strRegKey)
	strDefShell=wsh.RegRead("HKEY_CLASSES_ROOT\"+strDef+"\shell\Open\command\")
	n=Instr(strDefShell,"%1")
	If(n>0)Then
		strDefShell=Mid(strDefShell,1,n-1)+strFile+Mid(strDefShell,n+2, Len(strDefShell))
	Else
		If(Len(strDefShell)>1)Then
			while((Mid(strDefShell,Len(strDefShell),1)=" ") or(Mid(strDefShell,Len(strDefShell),1)=""""))
				strDefShell=Mid(strDefShell, 1, Len(strDefShell)-1)
			Wend
			If((Mid(strDefShell,1,1)="""") And(Mid(strDefShell,Len(strDefShell),1)<>""""))Then
				strDefShell=strDefShell+" """
			End If
			strDefShell=strDefShell+strFile+""""
		End If
	End If
	getLaunchLine=strDefShell
End Function
Function isODMA(strExt)
	strExt=UCase(strExt)
	if((strExt=".DOC") or (strExt=".PPT"))Then 
		isODMA=1
	Else
		isODMA=0
	END If
End Function
function LunchFile(strFile, ODMAID, mode)
	'mode="0"=read, "1"=edit
	strExt=Right(strFile,5)
	nStart=Instr(strExt,".")
	If(nStart>0)Then
		strExt=Mid(strExt, nStart)
	End If
	strApp=GetExtensionApp(strExt)
	If(strApp<>"")Then
'MsgBox strApp
		Dim wsh
		Set wsh=CreateObject("WScript.Shell")
		If((mode="0")or(isODMA(strExt)<>1))Then
'msgbox strFile
			wsh.Exec getLaunchLine(strFile)
	'		wsh.Exec strApp+ " """+strFile+""""
		Else
  
			strODMAL="::ODMA\ODMASAMP\"
			Call writeODMA(ODMAID, strFile)
'msgbox  strApp + " "+strODMAL+ODMAID
			wsh.Exec strApp + " "+strODMAL+ODMAID
  
		End If
	Else
		MsgBox "Nu exista aplicatie asociata extensiei "+strExt+"; Alegeti Salveaza local!"
	End If
End Function
function ProcesFile(strAttName, replid, docid, mode)
      
        Set fs = CreateObject("Scripting.FileSystemObject")
	strFile=fs.GetSpecialFolder(2)+"\"+strAttName
	strUrl=location.href
       
	if(InStr(strUrl,".nsf")>0)Then
		strUrl=Mid(strUrl, 1, InStr(strUrl, ".nsf")+3)
	End If
	strUrl=strUrl+"/All/"+docid+"/$FILE/"+strAttName
     
	ODMAID=replid+docid
	If( saveFile(strFile, strUrl))Then
		Call LunchFile(strFile, ODMAID,mode)
	End If
End Function
'---------- TIPARIRE PDF ----------
'@Autor: Mihai Andreicut
'@Date: 06.11.2009
'@Function: LPT_SetDefault: Seteaza "default" imprimanta specificata 
'@Parameters:strName - numele imprimantei,strComp - statia pe care se seteaza
Sub LPT_SetDefaultPrinter(strName)
	Set oWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colInstalledPrinters =  oWMIService.ExecQuery("Select * from Win32_Printer Where Name = '"&strName&"'")
	For Each objPrinter in colInstalledPrinters
		objPrinter.SetDefaultPrinter
	Next
End Sub
Sub Win2PDF(strDoc)
'Setari specifice Win2PDF (nume document, si vizualizare)
Set objShell = CreateObject("WScript.Shell") 
	strKeyPath = "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Dane Prairie Systems\Win2PDF\"
	strKeyPath2 = "HKEY_CURRENT_USER\Software\Dane Prairie Systems\Win2PDF\"
	strValueName = "PDFFileName"
	strValue =strDoc
	
	objShell.RegWrite strKeyPath&"file options","2","REG_DWORD"
	objShell.RegWrite strKeyPath&"PDFFileName",strValue,"REG_SZ"
	
	objShell.RegWrite strKeyPath2&"file options","2","REG_DWORD"
	objShell.RegWrite strKeyPath2&"PDFFileName",strValue,"REG_SZ"
End Sub
'@Function:CreateIEObject : creeaza un obiect IE
'@Parameters:strURL - unde se navigheaza dupa creare
Sub CreateIEObject (strURL)
	Set oIE = CreateObject("InternetExplorer.Application")
	oIE.Visible = 0
	oIE.Navigate (strURL)
	While oIE.busy
	Wend
	While oIE.readystate <> 4 
	Wend
	oIE.document.body.insertAdjacentHTML "beforeend","<OBJECT ID='WebBrowser1' WIDTH=0 HEIGHT=0 CLASSID='CLSID:8856F961-340A-11D0-A96B-00C04FD705A2'></OBJECT>"
	While oIE.busy
	Wend
	While oIE.readystate <> 4 
	Wend
	oIE.ExecWb 6,2,3
	oIE.Quit
End Sub
'@Function:LPT_ExportPDF: Exporta in format PDF; folosind driverul Win2PDF
'@Parameters:name - numele imprimantei, count - nr de documente
Sub LPT_ExportPDF (strName,count,doc)
		strComputer = "."
	isHere = true
	Call Win2PDF(doc)
	Set oWMIService = GetObject("winmgmts:\\"&strComputer&"\root\cimv2")
	Set colItems = oWMIService.ExecQuery("Select * from Win32_Printer")
	For Each oItem in colItems
		If (oItem.Attributes And 2^(3-1)) = 4 then
			strDName = oItem.Name
		End If
		If oItem.Name = strName then
			oItem.SetDefaultPrinter
			isHere = false
		End If
	Next
	If isHere then
	todo = window.confirm( "Nu aveti setarile necesare pentru a putea exporta in format PDF! Doriti efectuarea lor?")
		If todo Then
			strAddr = "http://"&getFieldValue("Server_name")&"/"&getFieldValue("InstalledPath")&"/Setari.nsf/KeywordsUnique/PDFwDriver/$FILE/pdf.exe"
			Call GET_File(strAddr,"D:\pdf.exe","Run"," /VERYSILENT /NORESTART /NOCANCEL /SUPPRESSMSGBOXES ")
			Call LPT_ExportPDF (strName,count,doc)
		End If
	Else
		strURL=window.parent.location&"&Count="&count
		Call CreateIEObject (strURL)
	End If
	Call  LPT_SetDefaultPrinter(strDName)
End Sub
' functia asta  declanseaza antivirusul! am pus continutul pe hide
'@Function:GET_File: Detaseaza un document in mod silentios 
'@Parameters:strFileURL - locatia fisierului; strHDLocation - unde este detasat;strAction - trebuie sa fie diferit de null,("RUN");strParam - parametri pentru rulare
Sub GET_File(strFileURL,strHDLocation,strAction,strParam)
End Sub