I have the following code in VBS that works perfectly. it queries AD to get the user full name :
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strFullName = objUser.Get("displayName")
MsgBox strFullName
i would like to do the same thin but in Foxpro 7. anybody has experience with VFP 7 or 9 ?
sys(0) returns both machine name and user something like
lcMachineUser = sys(0)
lcMachine = LEFT( lcMachineUser, AT( "#", lcMachineUser) -1 )
lcUserName = substr( lcMachineUser, AT( "#", lcMachineUser) +1 )
Alright, it seems like ths stuff is pretty old...and it's true ! ;)
i've found a solution however, this can help someone, somewhere, someday :)
loScript = Createobject("MSScriptcontrol.scriptcontrol.1")
loScript.Language = "VBScript"
TESTVBS = [Set objSysInfo = CreateObject("ADSystemInfo")] + chr(13)+chr(10)+;
[strUser = objSysInfo.UserName] + chr(13)+chr(10)+;
[Set objUser = GetObject("LDAP://" & strUser)] + chr(13)+chr(10)+;
[strFullName = objUser.Get("displayName")] + chr(13)+chr(10)
*[MsgBox strFullName]
loScript.executestatement(TESTVBS)
this is how you execute VBS from Foxpro code...two technologies that are not technologies anymore :)
This will get the user's name from the environmental variables.
username = GETENV("UserName")
I 'm using this function:
FUNCTION Get_User()
LOCAL cUsrBuf, nUsrLen, cUserName
cUsrBuf = SPACE(20)
nUsrLen = 20
DECLARE GetUserName IN advapi32 AS GetUserName STRING #cusrbuf, LONG #nusrlen
=GetUserName(#cusrbuf, #nusrlen)
cUserName = LEFT(ALLTRIM(cusrbuf), LEN(ALLTRIM(cusrbuf)) - 1)
RETURN cUserName
ENDFUNC
I would avoid using SYS(0) because:
SYS(0) returns 1 when using Visual FoxPro in a stand-alone environment
Only when the machine is connected to a network, SYS(0) returns the machine name, a space, a number sign (#) followed by another space, and then the id of the current user (or the security context in which Visual FoxPro is running).
Related
Im currently facing problem where the Component GUID of msi are in lower case. Need to convert all the Component GUID to upper case, hence wrote a small script as below:
VBS:
msi_fullpath = <Path of msi>
Dim strLine
strLine = "UPDATE Component SET ComponentId = UPPER(ComponentId)"
Set WI = CreateObject("WindowsInstaller.Installer")
Set DB = WI.OpenDatabase(msi_fullpath, 1)
' Update
Set view = DB.OpenView(strLine)
view.Execute
DB.Commit
View.Close
Set view = Nothing
Set DB = Nothing
Set WI = Nothing
However the above does not work. Can someone please help?
I've got a classic ASP application that contacts a database and receives a valid response but then crashes with
Error Number 9: Subscript out of range
after exiting the IF block the db call is made in. What's odd is that the same code is currently working in production. As far as I can tell they're configured identically (but I suspect there's a subtle difference that's causing this issue) and have identical code bases.
What I want to know is:
Where is this array that I'm supposedly attempting to reach a non-existent index of? I don't see it and the error gives no line number. Is there a chance something is not working correctly in the adodb library?
Perhaps this is a common problem having to do with a certain patch and my particular db connection library? Have you had a similar experience?
How do I troubleshoot a problem that doesn't immediately present itself? Should I just start putting troubleshooting statements in the library?
Explanation of what's happening in the code: When the cookie "click" is received err.number is 0. When the cookie "bang" is received the err.number is 9. It then crashes with that error at the end of the IF block.
<%#Language="VBSCRIPT"%>
<% Server.ScriptTimeout = 150 %>
<%
On Error resume Next
%>
<!--#include file="adovbs.inc"-->
<!--#INCLUDE FILE="DBConn.asp"-->
<!--#INCLUDE FILE="ErrorHandler.asp"-->
<%
'Application Timeout Warning
sessionTimeout = 20
advanceWarning = 5
jsTimeout = (sessionTimeout - advanceWarning) * 60000
'If the users session has expired
If Session("USERNAME") = "" or Session("USERNAME") = NULL Then
Response.Redirect("default.asp")
End If
'If the user has just changed their password. Prompt them that it was successfully changed
If Request("changePasswd") = "true" Then
Response.Write("<script language='Javascript'>alert('Your Password Has been Successfully Changed!');</script>")
End If
Dim connection, cmd, objRS, latestDate, lastDateJPMC, firstDateJPMC, lastDateWACH, firstDateWACH, lastDateWFB, firstDateWFB, accountCount
Function calConvertDate(theDate)
Dim yr, mn, dy, dtSplit
dtSplit = Split(theDate,"/")
yr = dtSplit(2)
mn = dtSplit(0)
dy = dtSplit(1)
if Len(mn) = 1 then mn = "0" & mn
if Len(dy) = 1 then dy = "0" & dy
calConvertDate = "[" & yr & "," & mn & "]"
End Function
set connection = Server.CreateObject("adodb.connection")
connection.Open DBConn
connection.CommandTimeout = 60
set connection = Server.CreateObject("adodb.connection")
connection.Open DBConn
connection.CommandTimeout = 60
'Get Earliest & Latest Date in Database
If Err.Number = 0 Then
Response.Cookies("CLICK")=Err.number
Set cmd = Server.CreateObject("ADODB.Command")
With cmd
Set .ActiveConnection = connection
.CommandText = "CIRS_Admin.spGetLatestDate"
.CommandType = adCmdStoredProc
set objRS = .Execute
End With
latestDate = calConvertDate(objRS("latestDate"))
Response.Cookies("latestdate")=objRS("latestDate")
objRS.Close
Set objRS = Nothing
Response.Cookies("BANG")=Err.number
End If
To debug, please add a statement like
Response.Write (objRS("latestDate"))
before the line
latestDate = calConvertDate(objRS("latestDate"))
so you can see if (for example) the date returned from the server has "-" as separator instead of "/" or if an empty value is returned.
After understanding what is causing the problem you can solve it
1.Where is this array that I'm supposedly attempting to reach a non-existent index of? I don't see it and the error gives no line number. Is there a chance something is not working correctly in the adodb library?
This is your array:
yr = dtSplit(2)
mn = dtSplit(0)
dy = dtSplit(1)
What's odd is that the same code is currently working in production. As far as I can tell they're configured identically (but I suspect there's a subtle difference that's causing this issue) and have identical code bases.
May be you have different regional settings?
I strongly suggest to you use better error handling.
Internal Server Error 500 w/ IIS Log
I have been a longtime lurker of stackoverflow and have now decided to join. I am trying to pull a list of every Functional Location out of SAP using BAPI. When I run this code it returns with an empty table. I dont have very much experiance with BAPI and I am trying to teach myself. Can someone please help with what im missing to make this work.
Thanks,
See code bellow:
Dim sapFunc As New SAPFunctionsOCX.SAPFunctions
Dim objServer = sapFunc.Connection
objServer.Client = "101"
objServer.User = "MyUserName"
objServer.Ticket = "MyKey"
objServer.system = "PEC"
objServer.MessageServer = "MyMessagerServer"
objServer.GroupName = "PUBLIC"
If objServer.logon(0, True) <> True Then
MsgBox("Key Rejected")
Exit Sub
End If
Dim objRfcFunc As SAPFunctionsOCX.Function
objRfcFunc = sapFunc.Add("BAPI_FUNCLOC_GETLIST")
'System.Console.Write(objRfcFunc.Description)
If objRfcFunc.Call = False Then
MsgBox("Error occured - " & objRfcFunc.Exception)
Exit Sub
End If
Dim tab = objRfcFunc.Tables("FUNCLOC_LIST")
System.Console.WriteLine("Input start:")
For I = 1 To tab.RowCount
For j = 1 To tab.ColumnCount
System.Console.Write(tab.ColumnName(j) + ":")
System.Console.WriteLine(tab.Cell(I, j))
Next
Next
System.Console.WriteLine("Input end.")
I don't intend for this to be an answer, but if it helps then that's good. If it doesn't, I'll delete it.
With objRfcFunc.tables("funcloc_ra")
If .RowCount < 1 Then .Rows.Add
.cell(1, 1) = "I"
.cell(1, 2) = "EQ"
.cell(1, 3) = "Your Func Loc"
End With
Do this after setting objRfcFunc and before calling it. The call will use these parameters.
I means to Include, EQ means you want to find items equal to the value in low.
I have a small vbscript file that queries a mysql database and returns a recordset which I then send to excel.
The problem is that the recordset does not return russian characters, it only returns "?" for each character.
My code is
dim adoConn
dim adoRS
dim n
set adoConn = Createobject("ADODB.Connection")
set adoRS = Createobject("ADODB.Recordset")
adoConn.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=server1;DATABASE=dbtest;USER=root;PASSWORD=daveeades;OPTION=3;"
adoRS.ActiveConnection = adoConn
n=1
if adoConn.errors.count = 0 then
'now get all necessary text comments
adoRS.Open "SELECT `tbllaunchdata`.`fldResponse` FROM `tbllaunchdata`"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
While (Not adoRS.EOF)
objExcel.Cells(n, 1).Value = adoRS("fldResponse")
n = n + 1
adoRS.Movenext()
Wend
end if
adoRS.close
set adoRS=nothing
adoConn.close
set adoConn=nothing
Could anyone please help me with this, I just can't get the unicode characters showing in excel.
Many thanks
Dave
There are many possible culprits.
To start with an easy check: Start - Programs - MS Office Tools - Ms
Office Languge Settings => Is Russian enabled?
For completeness: can you use "show variables" or "\s" to make sure of the MySQL character_set_client/connection/database/... and the collations? (I can do tests with a strict utf8 config (on a linux machine)
WRT comment: can you do a test like this
Air! code:
Dim sTest : sTest = "expected russian string"
adoRS.Open "SELECT `tbllaunchdata`.`fldResponse` FROM `tbllaunchdata`"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(0, 1).Value = adoRS("fldResponse")
objExcel.Cells(1, 1).Value = sTest
objExcel.Cells(2, 1).Value = CStr( sTest = adoRS("fldResponse") )
No thanks to me: looks like the the real important item should be:
use up-to-date software components!
Hiii .. I have the sameproblem.. But i can get the currect data from DB. But while displaying it on excel cell it shows as ????...If u got any solution please let me know.. To get pass Unicode data to Ms sql server we need to Use NVarchar Data Type... with adVarWChar..
Regards,
Liyo Jose.
I'm gettinga n error message in line 8 when I try to call out the script to stop when it finds teh attribute in the Web page: field in AD.
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
strwWWHomePage = objItem.Get("wWWHomePage")
If wWWHomePage 6 Then
wscript.quit
Else
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
ppt.Presentations.Open "\\abngan01\tracking\ppt.pptx"
End If
You have:
If wWWHomePage 6 Then
I'm assuming you want it to say:
If wWWHomePage = 6 Then
Since the missing "=" will cause an error, but since that code really doesn't do anything anyway, other than just abort the script, you could simplify your code by only taking action if that value is not set, for example:
If objItem.Get("wWWHomePage") <> 6 Then
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = True
ppt.Presentations.Open "\\abngan01\tracking\ppt.pptx"
End If
I'm also assuming "6" is some sort of flag you've set yourself, you might want to use something a little more descriptive like "PPTSTATUS006", or something along those lines.