czwartek, 29 października 2009

Ustawienie stałego portu dla wybranej instancji serwera MSSQL 2005

Funkcja pobiera dynamicznie ustawiony Port przez serwer SQL i przypisuje go jako stały

function BOOL SetFixedPortMS(sInstancja,sPort,bLog)
string sKey,sValue,sData,sKatInstancji;
number nResult,nResult1,nResult2,nType,nSize;
BOOL bSET;
begin                      
  Disable(LOGGING);
  bSET=FALSE;
  RegDBSetDefaultRoot( HKEY_LOCAL_MACHINE );  
  sKey="Software\\Microsoft\\Microsoft SQL Server\\"+sInstancja+"\\Setup";
  nType = REGDB_STRING_MULTI;
  nSize = 255;
  if (RegDBKeyExist(sKey)=1) then
     sValue = "SQLPath";
     nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sData, nSize );    
     sKatInstancji = GetWord("" ^ sData,0); 
     sPort = GetDynamicPort(sInstancja,bLog);                              //Pobierz dynamiczny Port
     if (bLog) then WriteLog(1,"Ustawienie stałego portu TCP na nr : "+sPort);  endif;
     sKey = "Software\\Microsoft\\Microsoft SQL Server\\"+sKatInstancji+"\\MSSQLServer\\SuperSocketNetLib\\Tcp\\IPAll";    
     if (RegDBKeyExist(sKey)=1) then
        sValue = "TcpPort";       
        nResult = RegDBSetKeyValueEx ( sKey, sValue, nType, sPort, nSize );       
        sValue = "TcpDynamicPorts";
        nResult1 = RegDBSetKeyValueEx ( sKey, sValue, nType, "", nSize );               
     else                           
        if (bLog) then WriteLog(2,"- nie ustawiono. Brak klucza TCP przy katalogu instancji");    endif;
        bSET = FALSE;  //Nieznaleziono wpisu o kluczu TCP/IP
     endif;  
     //Ustawienie dla pozostalych TCP portow stalych
     sKey = "Software\\Microsoft\\Microsoft SQL Server\\"+sKatInstancji+"\\MSSQLServer\\SuperSocketNetLib\\Tcp\\IP1";    
     if (RegDBKeyExist(sKey)=1) then
        sValue = "TcpPort";              
        RegDBSetKeyValueEx ( sKey, sValue, nType, sPort, nSize );       
        sValue = "TcpDynamicPorts";       
        RegDBSetKeyValueEx ( sKey, sValue, nType, "", nSize );               
     endif;
    
     sKey = "Software\\Microsoft\\Microsoft SQL Server\\"+sKatInstancji+"\\MSSQLServer\\SuperSocketNetLib\\Tcp\\IP2";    
     if (RegDBKeyExist(sKey)=1) then
        sValue = "TcpPort";               
        RegDBSetKeyValueEx ( sKey, sValue, nType, sPort, nSize );       
        sValue = "TcpDynamicPorts";       
        RegDBSetKeyValueEx ( sKey, sValue, nType, "", nSize );               
     endif;
    
     sKey = "Software\\Microsoft\\Microsoft SQL Server\\"+sInstancja+"\\MSSQLServer\\SuperSocketNetLib\\Tcp";    
     if (RegDBKeyExist(sKey)=1) then
        sValue = "TcpPort";        
        nResult2 = RegDBSetKeyValueEx ( sKey, sValue, nType, sPort, nSize );       
     else
        if (bLog) then WriteLog(2,"- nie ustawiono stałego portu. Brak klucza rejestru TCP przy instancji");    endif;
        bSET = FALSE;  //Nieznaleziono wpisu o kluczu TCP/IP
     endif;                                                       
    
     if (nResult=0)&&(nResult1=0)&&(nResult2=0) then
        if (bLog) then WriteLog(2,"- ustawiono stały port na : "+sPort);    endif;
        bSET = TRUE;
     else
       if (bLog) then WriteLog(2,"- wystąpił błąd przy ustawieniu stałego port na : "+sPort);    endif; 
     endif;
    
  else                                
      if (bLog) then WriteLog(2,"- nie ustawiono stałego portu. Brak wpisu o instancji");      endif;
      bSET = FALSE;  //Nieznalezniono wpisu o zainstalowanej Instancji
  endif;                                                                
                  
 Enable(LOGGING);                 
 return bSET;
end;
Posted by Przemas o października 29, 2009 0 komentarze
Etykiety:

Funkcja ustawiająca odpowiednią pozycję ProgressBar-a

Parametrami funkcji są:
svDialogName - nazwa okna dialogowego z Progressbar-em
nControlID - ID - kontrolki ProgressBar-a
nPos - pozycja do ustawienia
Komunikat przesłany do kontrolki ma definicję:
#define PBM_SETPOS              (WM_USER+2)

function ProgressBar_SetPosition(svDialogName, nControlID, nPos)
    number hCtrl;
    NUMBER  nResult;                           
    HWND hDlg;
begin
    hDlg = CmdGetHwndDlg( svDialogName );
    hCtrl = GetDlgItem(hDlg, nControlID);
    nResult = SendMessage(hCtrl, PBM_SETPOS, nPos, 0);
    return nResult;
end;      
Posted by Przemas o października 29, 2009 0 komentarze
Etykiety:

Funkcja ustawiająca zakres ProgressBar-a w oknie dialogowym

Funkcja korzysta z przesłania komunikatu do kontrolki ProgressBar, zmienna PBM_SETRANGE32 zawiera identyfikator odpowiedniego komunikatu.
#define PBM_SETRANGE32          (WM_USER+6)
Parametry:
hDlg - uchwyt okna w którym znajduje się ProgressBar,
nControlID - ID kontrolki na oknie
nMin/nMax - wartości

function ProgressBar_SetRange32(hDlg, nControlID, nMin, nMax)
    number hCtrl;
    NUMBER  nResult;
begin
    hCtrl = GetDlgItem(hDlg, nControlID);
    nResult = SendMessage(hCtrl, PBM_SETRANGE32, nMin, nMax);
    return nResult;
end;                 
Posted by Przemas o października 29, 2009 0 komentarze
Etykiety:

Obsługa ProgressBar-a w oknie dialogowym InstallShield

Obsługa ProgressBar-a wstawionego w okno dialogowe InstallShiled-a wymaga użycia dwóch funkcji:
1. Do ustawienia max progressu ProgressBar_SetRange32
2. Do ustawienia bieżącej pozycji ProgressBar_SetPosition
Obie funkcje należy uzyć odpowiednio przy implementacji okna dialogowego zawierającego ProgressBar
Posted by Przemas o października 29, 2009 0 komentarze
Etykiety:

środa, 28 października 2009

Konwersja string na RTF 

CString StrToRTF(CString str)
{

CString szRtfEnd = "}";
CString szRtfEnter = "\\par \\pard\\fi0\\li0\\ql\\ri0\\sb0\\sa0\\itap0 ";
CString szOut =
"{\\rtf1\\ansi\\ansicpg0\\uc1\\deff0\\deflang0\\deflangfe0{\\fonttbl{\\f0\\fnil\\fcharset1 Times New Roman;}{\\f1\\fnil\\fcharset1 Arial;}{\\f2\\fnil\\fcharset1 Verdana;}{\\f3\\fnil\\fcharset1 Courier New;}}\n"
"{\\colortbl;\\red0\\green0\\blue0;\\red0\\green0\\blue255;\\red0\\green255\\blue255;\\red0\\green255\\blue0;\\red255\\green0\\blue255;\\red255\\green0\\blue0;\\red255\\green255\\blue0;\\red255\\green255\\blue255;\n"
"\\red0\\green0\\blue128;\\red0\\green128\\blue128;\\red0\\green128\\blue0;\\red128\\green0\\blue128;\\red128\\green0\\blue0;\\red128\\green128\\blue0;\\red128\\green128\\blue128;\\red192\\green192\\blue192;}\n"
"\n\r"
"\\uc1\n\r"
"\\pard\\fi0\\li0\\ql\\ri0\\sb0\\sa0\\itap0 \\plain \\f3\\fs20\n\r";

str.Replace("\r\n",szRtfEnter);


CString szHex;
CString szBuf;

char buffer[10];// w tej tablicy znakowej będzie umieszczony wynik konwersji
for (int i=128; i<=256 ;i++)
 {
  itoa(i, buffer, 16);// konwersja na system szesnastkowy
  szHex = "0x";
  szHex += buffer;  
  szBuf = "\\'";
  szBuf +=buffer;    
  str.Replace((CString)(char)i,szBuf);  
 }

 szOut +=str;
 szOut +=szRtfEnd;

 return szOut;
}
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Sprawdzenie poprawności numeru ISSN


BOOL CheckISSN( CString szISSN)
{
BOOL bReturn = FALSE;
int nCyfra;
int nSuma = 0;
int nMod = 0;
int nCheck;
int i;

if (szISSN.GetLength()==9) {

if (szISSN.GetAt(4)=='-') {
for (i=0 ;i<8 ; i++) { if (i!=4) { nCyfra = stoi (szISSN.GetAt(i)); if ((nCyfra<0)||(nCyfra>9)) return FALSE;
}
}

if (szISSN.GetAt(8)!='X') {
nCyfra = stoi (szISSN.GetAt(8));
if ((nCyfra<0)||(nCyfra>9)) return FALSE;
nCheck = nCyfra;
} else nCheck = 10;

nCyfra = stoi (szISSN.GetAt(0));
nSuma += nCyfra*8;
nCyfra = stoi (szISSN.GetAt(1));
nSuma += nCyfra*7;
nCyfra = stoi (szISSN.GetAt(2));
nSuma += nCyfra*6;
nCyfra = stoi (szISSN.GetAt(3));
nSuma += nCyfra*5;
nCyfra = stoi (szISSN.GetAt(5));
nSuma += nCyfra*4;
nCyfra = stoi (szISSN.GetAt(6));
nSuma += nCyfra*3;
nCyfra = stoi (szISSN.GetAt(7));
nSuma += nCyfra*2;

nMod = nSuma % 11;

if ( (11 - nMod) == nCheck ) bReturn = TRUE;
}
}

return bReturn;
}
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Pobranie dynamicznego numeru portu przydzielonego do instancji MSSQL


function string GetDynamicPort(sInstancja,bLog)
string sKey, sValue, sData;
string sMsg,sKatInstancji, Port;
number nType, nSize, nResult;
begin
Port="";
RegDBSetDefaultRoot(HKEY_LOCAL_MACHINE);
sKey="Software\\Microsoft\\Microsoft SQL Server\\"+sInstancja+"\\Setup";
if (RegDBKeyExist(sKey)=1) then
sValue = "SQLPath";
nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sData, nSize );
sKatInstancji = GetWord("" ^ sData,0);
//Port
sKey = "Software\\Microsoft\\Microsoft SQL Server\\"+sKatInstancji+"\\MSSQLServer\\SuperSocketNetLib\\Tcp\\IPAll";
if (RegDBKeyExist(sKey)=1) then
nType = REGDB_STRING_MULTI;
sValue = "TcpDynamicPorts";
nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sData, nSize );
if( nResult = 0 ) then
if (StrLength(sData)>1) then
Port=sData;
else
if (bLog) then WriteLog(2,"port dynamiczny nie przydzielony do instancji : "+sInstancja); endif;
endif;
endif;
else
if (bLog) then WriteLog(2,"brak klucza rejestru z przydzielonymi portami dynamicznymi"); endif;
endif;
else
if (bLog) then WriteLog(2,"brak klucza rejestru z instancją : "+sInstancja); endif;
endif;
return Port;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Pobranie listy źrodeł ODBC


function BOOL GetODBCList(nvList, bLog)
#define KEY1 "SOFTWARE\\ODBC\\ODBC.INI"
BOOL bResult;
number nReturn;
string szline;
int i;
begin
bResult = FALSE;
if bLog then WriteLog(0,"* Pobranie listy źrodeł ODBC (DSN)"); endif;
RegDBSetDefaultRoot(HKEY_LOCAL_MACHINE);
nReturn = RegDBQueryKey(KEY1, REGDB_KEYS, nvList );
if (nReturn < 0) then bResult = FALSE; else bResult = TRUE; ListSetIndex(nvList,LISTFIRST); ListODBC: for i=0 to ListCount(nvList)-1 ListCurrentString ( nvList, szline ); if (StrCompare(szline,"ODBC Data Sources")=0)||(StrCompare(szline,"ODBC File DSN")=0) then ListDeleteString(nvList); goto ListODBC; endif; ListSetIndex(nvList,LISTNEXT); endfor; endif; return bResult; end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Wykrycie źródła ODBC do podanej nazwy


function BOOL DetectODBC(sNazwa, sServer, sDataBase, nVerDriver)
string RegPath,sVersion,sVer,sKey,sValue,sDriver;
BOOL bResult, bFind;
number nSize,nType,nResult;
begin
bResult = TRUE;bFind = FALSE;
WriteLog(0,"* Sprawdzenie istniejących źrodeł ODBC");
RegDBSetDefaultRoot(HKEY_LOCAL_MACHINE);
RegPath="SOFTWARE\\ODBC\\ODBC.INI\\"+sNazwa;
if (RegDBKeyExist(RegPath)==1) then
bFind=TRUE;
//Odczyt Serwera i Bazy i zwrocenie przez referencje
sServer="";
sKey="";
sKey = "SOFTWARE\\ODBC\\ODBC.INI\\"+sNazwa;
sValue = "Server";
nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sServer, nSize );
sValue = "Database";
nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sDataBase, nSize );
sValue = "Driver";
nResult = RegDBGetKeyValueEx( sKey, sValue, nType, sDriver, nSize );
endif;


RegPath="SOFTWARE\\ODBC\\ODBC.INI\\ODBC Data Sources";
if (RegDBKeyExist(RegPath)==1) then
if (RegDBGetKeyValueEx(RegPath,sNazwa,nType,sVersion,nSize)=0) then
bFind=TRUE;
endif;
endif;
if (bFind) then
WriteLog(1,"- znaleziono źrodla ODBC do "+sNazwa);
WriteLog(2,"Nazwa Serwera SQL :"+sServer);
if (StrLength(sDataBase)>0) then WriteLog(2,"Nazwa bazy danych :"+sDataBase);
else WriteLog(2,"Nazwa bazy danych : nie ustalona w źrodłach");
endif;
if (StrLength(sDriver)>0) then
WriteLog(2,"Sterownik do bazy danych :"+sDriver);
ParsePath(sVer,sDriver,FILENAME);
if (StrCompare(sVer,"sqlncli.dll")=0) then nVerDriver = 90; endif;
if (StrCompare(sVer,"sqlsrv32.dll")=0) then nVerDriver = 80; endif;
else
WriteLog(2,"Nazwa sterownika : nie ustalona w źrodłach");
endif;
if (StrLength(sServer)>0)&&(StrLength(sDataBase)>0) then return TRUE;
else return FALSE;
endif;

else
WriteLog(1,"- brak istniejących źródeł ODBC do "+sNazwa);
endif;

end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Pobranie nazwy komputera


function STRING _GetComputerName()
#ifndef MAX_COMPUTERNAME_LENGTH
#define MAX_COMPUTERNAME_LENGTH 31
#endif
STRING szDLL;
number nReturn;
STRING szCompName[MAX_COMPUTERNAME_LENGTH+1];
LONG lvBuffer, nResult;
begin
szDLL = WINSYSDIR ^ "kernel32.DLL";
nReturn = UseDLL ( szDLL );
if (nReturn < 0) then MessageBox("Nie moża otworzyć kernel32.DLL", SEVERE); exit; else lvBuffer = MAX_COMPUTERNAME_LENGTH+1; nResult = GetComputerName(szCompName, lvBuffer); return szCompName; endif; UnUseDLL ( szDLL ); end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Ustawienie zmiennej środowiskowej w systemie

Po ustawieniu zmiennej środowiskowej wymagany jest restart systemu

function BOOL SetEnvironment(szName, szValue, bDodaj, bLog)
#define WM_WININICHANGE 0x001A
#define WM_SETTINGCHANGE 0x001A
#define SMTO_ABORTIFHUNG 0x2
#define HWND_BROADCAST 0xffff
BOOL bResult;
NUMBER nResult, nvSize, nType;
NUMBER nvFileHandle;
STRING szKey, szEnv, svValue;
STRING szProgram, szCmdLine, szLine;
LONG bvReturn;
BOOL bFind;
POINTER pEnv;
LIST szList1;
int i;
begin
if (bLog) then WriteLog(0,"Ustawienie zmiennej środowiskowej "+szName+"..."); endif;
bResult = FALSE;
nvSize = -1;
//nType = REGDB_STRING;
nType = REGDB_STRING_EXPAND;
szKey = "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment";
RegDBSetDefaultRoot(HKEY_LOCAL_MACHINE);
if !bDodaj then
if RegDBGetKeyValueEx (szKey, szName, nType, svValue, nvSize )=0 then //pobierz dotychczasowe wartosci
if StrFind(svValue,szValue)<0 then nResult = RegDBSetKeyValueEx(szKey, szName, REGDB_STRING, szValue, -1); //Ustawienie zmiennej else if bLog then WriteLog(1,"- zmienna systemowa ustawiona w systemie \""+szName+"\" o wartości: \""+szValue+"\""); endif; return FALSE; endif; else nResult = RegDBSetKeyValueEx(szKey, szName, REGDB_STRING, szValue, -1); //Ustaiwienie zmiennej endif; else if RegDBGetKeyValueEx (szKey, szName, nType, svValue, nvSize )=0 then //pobierz dotychczasowe wartosci if StrLength(svValue)>0 then
if StrFind(svValue,szValue)<0 then svValue = svValue + ";" + szValue; else if (bLog) then WriteLog(1,"- zmienna systemowa \""+szName+"\" o wartości: \""+szValue+"\" już ustawiona"); endif; return FALSE; endif; else svValue = szValue; endif; nResult = RegDBSetKeyValueEx(szKey, szName, REGDB_STRING, svValue, -1); else nResult = RegDBSetKeyValueEx(szKey, szName, REGDB_STRING, szValue, -1); //ustaw nowa zmienna endif; endif; if (nResult < 0) then if bLog then WriteLog(1,"- nie udało się ustawić zmiennej systemowej \""+szName+"\" o wartości: \""+szValue+"\""); endif; else if bLog then WriteLog(1,"- ustawiono zmienną systemową \""+szName+"\" o wartości: \""+szValue+"\""); endif; szEnv = "Environment"; pEnv = &szEnv; SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, pEnv ); bResult = TRUE; endif; return bResult; end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca czy w systemie włączona jest Polityka Haseł

Działa wyłącznie z zewnętrznym programem secedit.exe

function BOOL CheckPassPolicyOn(bLog)
BOOL bResult;
string szParam,szProgram,szLinia;
number nLinia,nvExitCode;
begin
bResult = FALSE;
if (Is(FILE_EXISTS,WINSYSDIR^"secedit.exe")) then
szProgram = WINSYSDIR^"secedit.exe";
szParam = '/export /cfg \"'+ TARGETDIR ^ 'secedit.log'+ '\" /areas SECURITYPOLICY';
_LaunchAppEx(szProgram, szParam, WAIT, SW_HIDE,-1,nvExitCode);
Delay(1);
if (Is(FILE_EXISTS,TARGETDIR^'secedit.log')) then
if (bLog) then WriteLog(1,"Sprawdzenie czy włączona \"Polityka Haseł Windows\""); endif;
if (FileGrep(TARGETDIR^'secedit.log', "PasswordComplexity", szLinia, nLinia, RESTART)=0) then
if (StrFind(szLinia,"1")>0) then
bResult = TRUE;
if (bLog) then WriteLog(2,"- włączona"); endif;
else
if (bLog) then WriteLog(2,"- wyłączona"); endif;
endif;
endif;
DeleteFile(TARGETDIR ^ 'secedit.log');
endif; //plik nie istnieje

ProcessEnd("secedit");
endif; //program nie istnieje

return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca czy polecenie DBCheckDB nie zwraca błedów


function BOOL DBCheckDB (sSQL, sServerName, sDBName, sDriver, bTrustedConn, sUserName, sUserPwd, bLog, szError)
OBJECT objConn, pADORecordSetObj, adoCommand;
STRING sTekst, sConnString;
STRING szADOConnObjID,szADORecordSetObjID;
number nPos;
BOOL bReturn;
begin
bReturn = FALSE;

// Create the connectionstring
if (sDriver == "") then
sConnString = "Provider=sqloledb;";
else
sConnString = "Driver={" + sDriver + "};";
endif;

if (bTrustedConn) then
//ACA_Log_AppendLine(" using Windows Authentication");
sConnString = sConnString + "server=" + sServerName + ";";
sConnString = sConnString + "database=" + sDBName + ";";
sConnString = sConnString + "Trusted_connection=Yes";
else
//ACA_Log_AppendLine(" using SQL Login");
sConnString = sConnString + "server=" + sServerName + ";";
sConnString = sConnString + "uid=" + sUserName + ";";
sConnString = sConnString + "pwd=" + sUserPwd + ";";
sConnString = sConnString + "database=" + sDBName;
endif;

try
szADOConnObjID = "ADODB.Connection";
set objConn = CreateObject(szADOConnObjID);

if (IsObject(objConn)) then

objConn.ConnectionString = sConnString;
objConn.CommandTimeout = 999999;
objConn.Open;

szADORecordSetObjID = "ADODB.Recordset";
set pADORecordSetObj = CreateObject(szADORecordSetObjID);
pADORecordSetObj.CursorType = 3;
pADORecordSetObj.ActiveConnection = objConn;
pADORecordSetObj.Open(sSQL);
if ((pADORecordSetObj.RecordCount >= 1)||(pADORecordSetObj.RecordCount = -1)) then
while (!pADORecordSetObj.EOF)
szError = pADORecordSetObj(3);
pADORecordSetObj.MoveNext;
endwhile;

if ((StrFind(szError,"found 0 allocation")>0)&&(StrFind(szError,"and 0 consistency")>0)) then
bReturn = TRUE;
else
bReturn = FALSE;
endif;
else
bReturn = FALSE;
endif;

else
if (bLog) then WriteLog(1,"Nie moża utworzyć obiektu połączenia ADODB.Connection do "+sDBName); endif;
endif;

set pADORecordSetObj = NOTHING;
set objConn = NOTHING;


catch
if (bLog) then WriteLog(1,"Błąd wykonania zapytania SQL"); endif;
endcatch;

return (bReturn);

end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja odczytująca konfigurację portów serwera Apache Tomcat


function BOOL GetTomcatPorts(szPath, svPortHTTP, svPortSHD, svPortAJP, bLog)
BOOL bResult, bFindHTTP, bFindSHD, bFindAJP;
LIST lsPlik;
string line, newline, szPortLine;
int i,nStart,nStop;
begin
if Is(FILE_EXISTS, szPath ^ "conf\\server.xml") then
bFindHTTP = FALSE;
bFindSHD = FALSE;
bFindAJP = FALSE;
lsPlik = ListCreate(STRINGLIST);
ListReadFromFile(lsPlik, szPath ^ "conf\\server.xml");
if ListCount(lsPlik)>0 then
ListSetIndex(lsPlik,LISTFIRST);
for i=0 to ListCount(lsPlik)-1
ListCurrentString(lsPlik,line);
if (StrFind(line,"Connector port")>=0) && (StrFind(line,'protocol="HTTP/1.1"')>=0) && (StrFind(line,'SSLEnabled')<0) then nStart = StrFind(line,"port"); nStart = nStart+6;//7 StrSub(szPortLine,line,nStart,10); nStop = StrFind(szPortLine,"\""); line = szPortLine; StrSub(szPortLine,line,0,nStop); svPortHTTP = szPortLine; if bLog then WriteLog(2,"- znaleziono konfigurację na Port HTTP: "+svPortHTTP); endif; bFindHTTP = TRUE; endif; if (StrFind(line,"Server port")>=0) && (StrFind(line,'shutdown="SHUTDOWN">')>=0) then
nStart = StrFind(line,"port");
nStart = nStart+6;
StrSub(szPortLine,line,nStart,10);
nStop = StrFind(szPortLine,"\"");
line = szPortLine;
StrSub(szPortLine,line,0,nStop);
svPortSHD = szPortLine;
if bLog then WriteLog(2,"- znaleziono konfigurację na Port ShutDown: "+svPortSHD); endif;
bFindSHD = TRUE;
endif;

if (StrFind(line,"Connector port=")>=0) && (StrFind(line,'protocol="AJP/1.3"')>=0) then
nStart = StrFind(line,"port");
nStart = nStart+6;
StrSub(szPortLine,line,nStart,10);
nStop = StrFind(szPortLine,"\"");
line = szPortLine;
StrSub(szPortLine,line,0,nStop);
svPortAJP = szPortLine;
if bLog then WriteLog(2,"- znaleziono konfigurację na Port AJP: "+svPortAJP); endif;
bFindAJP = TRUE;
endif;

ListSetIndex(lsPlik,LISTNEXT);
endfor;
endif;

//Zapis konfiguracji
if bFindHTTP then
bResult = TRUE;
else
if bLog then WriteLog(2,"- nie znaleziono konfiguracji Portu HTTP. Przypisano domyślny: 8080"); endif;
svPortHTTP = "8080";
endif;

if !bFindSHD then
if bLog then WriteLog(2,"- nie znaleziono konfiguracji Port Shutdown. Przypisano domyślny: 8005"); endif;
svPortSHD = "8005";
endif;

if !bFindAJP then
if bLog then WriteLog(2,"- nie znaleziono konfiguracji Port AJP. Przypisano domyślny: 8009"); endif;
svPortSHD = "8009";
endif;

ListDestroy(lsPlik);

else
if bLog then
WriteLog(1,"- plik konfiguracji \"server.xml\" serwera nie istnieje w katalogu:\""+szPath+"\"");
endif;
bResult = FALSE;
endif;

return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funckja sprawdzająca czy w systemie podane porty nie są używane

Funkcja wykorzystuje systemowy program netstat, porty do sprawdzenia podajemy w zmiennej szPorts rozdzielając przecinkiem

function BOOL CheckListenPorts(szPorts, svResult, bLog)
number hPlikBat, hFileLog;
BOOL bResult;
LIST lsPort,lsNetStat;
string szParam,svLine, szPort;
int i,j,nWait;
begin
if bLog then WriteLog(0,"* Sprawdzenie czy wybrane porty nie są w użyciu"); endif;
bResult = TRUE;
svResult = "";
lsPort = ListCreate(STRINGLIST);
lsNetStat = ListCreate(STRINGLIST);
StrGetTokens(lsPort,szPorts,",");

OpenFileMode (FILE_MODE_APPEND);
if (CreateFile (hPlikBat, TARGETDIR, "netstat.bat") < 0) then bResult = FALSE; else szParam = WINSYSDIR ^ "netstat.exe -a -n -p TCP >\""+ TARGETDIR ^ "netstat.log\"";
WriteLine(hPlikBat,szParam);
CloseFile(hPlikBat);
endif;

//Execute
if LaunchApplication(TARGETDIR ^ "netstat.bat", "", TARGETDIR, SW_HIDE, 0, LAAW_OPTION_USE_SHELLEXECUTE | LAAW_OPTION_WAIT | LAAW_OPTION_SHOW_HOURGLASS)=ISERR_SUCCESS then
nWait=0;
while !Is(FILE_EXISTS, TARGETDIR ^ "netstat.log")&&(nWait<5) Sleep(500); nWait = nWait + 1; endwhile; if Is(FILE_EXISTS, TARGETDIR ^ "netstat.log") then OpenFileMode (FILE_MODE_NORMAL); OpenFile (hFileLog, TARGETDIR, "netstat.log"); while (GetLine (hFileLog, svLine) = 0) StrSub(svLine,svLine,0, 32); ListAddString(lsNetStat,svLine,AFTER); endwhile; CloseFile (hFileLog); //Sprawdzenie Portow if (ListCount(lsPort)>0) && (ListCount(lsNetStat)>0) then
ListSetIndex(lsPort,LISTFIRST);
for i=0 to ListCount(lsPort)-1
ListCurrentString(lsPort,szPort);
ListSetIndex(lsNetStat,LISTFIRST);
for j=0 to ListCount(lsNetStat)-1
ListCurrentString(lsNetStat, svLine);
if StrFind(svLine,":"+szPort)>0 then
if StrLength(svResult)>0 then
svResult = svResult + "," + szPort;
else
svResult = szPort;
endif;
if bLog then WriteLog(1," - Port:"+szPort+" jest w użyciu"); endif;
endif;
ListSetIndex(lsNetStat,LISTNEXT);
endfor;
ListSetIndex(lsPort, LISTNEXT);
endfor;
endif;

else
if bLog then WriteLog(1," - plik nie został utworzony \""+TARGETDIR ^ "netstat.log"+"\""); endif;
bResult = FALSE;
endif;

endif;



ListDestroy(lsPort);
ListDestroy(lsNetStat);
return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Zmiana wartości do kluczy w pliku XML

Wymagane jest wcześniejsze stworzenie listy kluczy i listy odpowiadających im wartości

function BOOL XMLFileChange(szFile, nvListXMLKey, nvListXMLValue, bLog)
BOOL bResult;
LIST ListaPlikXML, ListaXMLLine;
STRING szLine, szKey, szValue, szString, szXMLLine, szFind, szEndLine;
INT i, j, k;
BOOL bKoniecLinii;
begin
bResult = FALSE;
if bLog then WriteLog(0,"Odczyt pliku XML ..."); endif;
if Is(FILE_EXISTS,szFile) then
ListaPlikXML = ListCreate(STRINGLIST);
if ListReadFromFile(ListaPlikXML,szFile)=0 then
ListSetIndex(ListaPlikXML, LISTFIRST);
for i=0 to ListCount(ListaPlikXML)-1
ListaXMLLine = ListCreate(STRINGLIST);
ListCurrentString(ListaPlikXML, szLine);
StrGetTokens ( ListaXMLLine, szLine , " " );
ListSetIndex(nvListXMLKey,LISTFIRST);
ListSetIndex(nvListXMLValue,LISTFIRST);
for j = 0 to ListCount(nvListXMLKey)-1
ListCurrentString(nvListXMLKey, szKey);
ListCurrentString(nvListXMLValue, szValue);
szString = szKey+"="+szValue;

ListSetIndex(ListaXMLLine,LISTFIRST);
for k=0 to ListCount(ListaXMLLine)-1
bKoniecLinii = FALSE;
ListCurrentString(ListaXMLLine, szFind);
if (StrFind(szFind,"/>")>0) then
bKoniecLinii = TRUE;
szEndLine = "/>";
elseif (StrFind(szFind,">")>0) then
bKoniecLinii = TRUE;
szEndLine = ">";
endif;

if StrFind(szFind,szKey)>=0 then
if (bLog) then WriteLog(1,"- zapis klucza \""+szKey+"\"");endif;
if bKoniecLinii then szString = szString+szEndLine; endif; //Dodanie konca linii
ListSetCurrentString(ListaXMLLine, szString); //zamien klucz z wartoscia
endif;

ListSetIndex(ListaXMLLine,LISTNEXT);
endfor;

ListSetIndex(nvListXMLKey,LISTNEXT);
ListSetIndex(nvListXMLValue,LISTNEXT);
endfor;

szXMLLine = "";
ListSetIndex(ListaXMLLine,LISTFIRST);
for k=0 to ListCount(ListaXMLLine)-1
ListCurrentString(ListaXMLLine, szString);
if StrLength(szXMLLine)>0 then
szXMLLine = szXMLLine + " " + szString;
else
szXMLLine = szString;
endif;
ListSetIndex(ListaXMLLine,LISTNEXT);
endfor;

ListSetCurrentString(ListaPlikXML, szXMLLine);
ListSetIndex(ListaPlikXML, LISTNEXT);
ListDestroy(ListaXMLLine);
endfor;


//Zapis pliku XML
if bLog then WriteLog(0,"Zapis pliku XML ..."); endif;
if ListWriteToFile(ListaPlikXML,szFile)=0 then //Odczyt pliku XML do listy
bResult = TRUE;
else
if bLog then WriteLog(0,"Wystąpił błąd zapisu pliku XML \""+szFile+"\" z listy XML"); endif;
endif;
else
if bLog then WriteLog(0,"Wystąpił błąd odczytu pliku XML\""+szFile+"\" do listy XML"); endif;
endif;
else
if bLog then WriteLog(0,"Plik XML \""+szFile+"\" nie istnieje!"); endif;
endif;


return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca czy na podanym użytkowniku i haśle możliwe jest podłączenie do bazy MSSQL


function BOOL CheckLoginPass(sServerName, sDBName, sDriver, bTrustedConn, sUserName, sUserPwd, bLog, bPatron)
OBJECT objConn;
STRING sConnString;
STRING szADOConnObjID;
BOOL bResult;
begin
bResult = FALSE;
// Create the connectionstring
if (sDriver == "") then
sConnString = "Provider=sqloledb;";
else
sConnString = "Driver={" + sDriver + "};";
endif;

if (bTrustedConn) then
//ACA_Log_AppendLine(" using Windows Authentication");
sConnString = sConnString + "server=" + sServerName + ";";
sConnString = sConnString + "database=" + sDBName + ";";
sConnString = sConnString + "Trusted_connection=Yes";
else
//ACA_Log_AppendLine(" using SQL Login");
sConnString = sConnString + "server=" + sServerName + ";";
sConnString = sConnString + "uid=" + sUserName + ";";
if bPatron then sUserPwd = GetPatronPass(sUserPwd); endif;
sConnString = sConnString + "pwd=" + sUserPwd + ";";
sConnString = sConnString + "database=" + sDBName;
endif;

try
szADOConnObjID = "ADODB.Connection";
set objConn = CreateObject(szADOConnObjID);

if (IsObject(objConn)) then
objConn.ConnectionString = sConnString;
objConn.Open;
bResult = TRUE; //Połączono
objConn.Close;
endif;

set objConn = NOTHING;

catch
if (bLog) then WriteLog(1," - Nie można uzyskać połączenia z bazą na użytkownika \""+sUserName+"\""); endif;
endcatch;

return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca czy podany DSN umożliwia podłączenie do bazy


function BOOL CheckDSNCon(sDSN, sUser, sPass)
OBJECT objConn;
STRING szADOConnObjID;
STRING sConnString;
BOOL bResult;
begin
bResult = FALSE;
try
szADOConnObjID = "ADODB.Connection";
set objConn = CreateObject(szADOConnObjID);
sConnString = "DSN="+sDSN+"; uid="+sUser+"; pwd="+sPass+";";

if (IsObject(objConn)) then
objConn.ConnectionString = sConnString;
objConn.Open;
bResult = TRUE;
objConn.Close;
endif;

set objConn = NOTHING;

catch
bResult = FALSE;
endcatch;

return bResult;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca czy podana baza jest w użyciu


function BOOL DatabaseInUse(svServerName, svDatabaseName, svDriver, svUserName, svUserPassword, nWersja)
OBJECT pADOConnObj, pADORecordSetObj;
STRING szADOConnObjID, szADORecordSetObjID, szConnString, szSQL;
BOOL bExists;
begin
bExists = FALSE;
// Create ADO Connection Object to connect to the SQL server
szADOConnObjID = "ADODB.Connection";
set pADOConnObj = CreateObject(szADOConnObjID);

// Create the SQL string to complete the connection
szConnString = "driver={" + svDriver + "};";
szConnString = szConnString + "server=" + svServerName + ";";
szConnString = szConnString + "uid=" + svUserName + ";";
szConnString = szConnString + "pwd=" + svUserPassword + ";";
szConnString = szConnString + "database=master";

// Open the ADO Connection
pADOConnObj.Open(szConnString);

// Create ADO Recordset object for the return
szADORecordSetObjID = "ADODB.Recordset";
set pADORecordSetObj = CreateObject(szADORecordSetObjID);

// Set some ADO Recordset properties
pADORecordSetObj.CursorType = 3;
pADORecordSetObj.ActiveConnection = pADOConnObj;

// Create the SQL string to retrieve the database if it exists
if (nWersja=80) then
szSQL = "select s.name from sysdatabases s, syslocks l where l.dbid=s.dbid and s.name='" + svDatabaseName + "'";
elseif (nWersja>=90) then
szSQL = "select s.name from sys.databases s, sys.syslockinfo l where l.rsc_dbid=s.database_id and s.name='" + svDatabaseName + "'";
endif;

// Use the recordset to see if the database exists
pADORecordSetObj.Open(szSQL);
if (pADORecordSetObj.RecordCount >= 1) then
bExists = TRUE;
endif;

set pADOConnObj = NOTHING;
set pADORecordSetObj = NOTHING;
return bExists;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funckcja sprawdczająca czy podana nazwa bazy jest zainstalowana na serwerze MSSQL

Funkcja działa poprawnie na serwerze MS-SQL 2000 i nowszym, przy czym parametr nWersja jest oznaczeniem wersji MS-SQL, dla 2000 nWersja = 80, 2005 nWersja=90/91/92/93

function BOOL DoesDatabaseExist(svServerName, svDatabaseName, svDriver, svUserName, svUserPassword, nWersja)
OBJECT pADOConnObj, pADORecordSetObj;
STRING szADOConnObjID, szADORecordSetObjID, szConnString, szSQL;
BOOL bExists;
begin
bExists = FALSE;
// Create ADO Connection Object to connect to the SQL server
szADOConnObjID = "ADODB.Connection";
set pADOConnObj = CreateObject(szADOConnObjID);

// Create the SQL string to complete the connection
szConnString = "driver={" + svDriver + "};";
szConnString = szConnString + "server=" + svServerName + ";";
szConnString = szConnString + "uid=" + svUserName + ";";
szConnString = szConnString + "pwd=" + svUserPassword + ";";
szConnString = szConnString + "database=master";

// Open the ADO Connection
pADOConnObj.Open(szConnString);

// Create ADO Recordset object for the return
szADORecordSetObjID = "ADODB.Recordset";
set pADORecordSetObj = CreateObject(szADORecordSetObjID);

// Set some ADO Recordset properties
pADORecordSetObj.CursorType = 3;
pADORecordSetObj.ActiveConnection = pADOConnObj;

// Create the SQL string to retrieve the database if it exists
if (nWersja=80) then
szSQL = "Select name from sysdatabases where name='" + svDatabaseName + "'";
elseif (nWersja>=90) then
szSQL = "Select name from sys.databases where name='" + svDatabaseName + "'";
endif;

// Use the recordset to see if the database exists
pADORecordSetObj.Open(szSQL);
if (pADORecordSetObj.RecordCount = 1) then
bExists = TRUE;
endif;

set pADOConnObj = NOTHING;
return bExists;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Funkcja sprawdzająca, czy podane hasło spełnia kryteria Polityki Bezpieczeństwa Haseł

Zwraca TRUE jeżeli parametr pass spełnia kryteria, w przeciwnym razie w parametrze message zwracany jest odpowiedni komunikat

function BOOL CheckPassPolicy(pass, message)
BOOL bPass,bResult;
string tab_AZ,tab_az,tab_09,tab_sc, znak, znak1;
CHAR ch,ch1;
int i, j, iKat;
begin
tab_AZ="AĄBCĆDEĘFGHIJKLŁMNŃOÓPQRSTUVWXYZŻŹ";
StrToLower(tab_az,tab_AZ);
tab_09="0123456789";
tab_sc="`!@#$%^*_+-";
bPass = TRUE;
iKat = 0;
if (StrLength(pass)<8) then message="Hasło nie może być krótsze niż 8 litery!"; bPass = FALSE; endif; // Kategoria 1. A..Z bResult = FALSE; for i=0 to StrLength(pass)-1 ch = pass[i]; for j=0 to StrLength(tab_AZ)-1 ch1 = tab_AZ[j]; if (ch = ch1) then bResult = TRUE; endif; endfor; endfor; if bResult then iKat = iKat + 1; endif; // Kategoria 2. a..z bResult = FALSE; for i=0 to StrLength(pass)-1 ch = pass[i]; for j=0 to StrLength(tab_az)-1 ch1 = tab_az[j]; if (ch = ch1) then bResult = TRUE; endif; endfor; endfor; if bResult then iKat = iKat + 1; endif; // Kategoria 3. 0..9 bResult = FALSE; for i=0 to StrLength(pass)-1 StrSub(znak,pass,i,1); if (StrFind(tab_09,znak)>=0) then bResult = TRUE; endif;
endfor;
if bResult then iKat = iKat + 1; endif;

// Kategoria 4. special chars
bResult = FALSE;
for i=0 to StrLength(pass)-1
StrSub(znak,pass,i,1);
if (StrFind(tab_sc,znak)>=0) then bResult = TRUE; endif;
endfor;
if bResult then iKat = iKat + 1; endif;

if (iKat<3) then bPass = FALSE; endif; //Zawartosc spacji w hasle if (StrFind(pass," ")>=0) then
bPass = FALSE;
if StrLength(message)=0 then message = "Hasło nie może zawierać spacji!";
else message = message + "\nHasło nie może zawierać spacji!";
endif;
endif;

return bPass;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

Sprawdzenie włączonej funckji DEP w systemie


function int CheckDEP(bLog)
int nWynik,nResult1,nResult2,nResult3,nResult4;
string szFile,svlinia,szRes;
number nvlinia;
begin
szFile = WINDISK ^ "boot.ini";
nResult1 = FileGrep(szFile,"NoExecute=AlwaysOn", svlinia, nvlinia, RESTART);
nResult2 = FileGrep(szFile,"NoExecute=OptOut", svlinia, nvlinia, RESTART);
nResult3 = FileGrep(szFile,"NoExecute=AlwaysOf", svlinia, nvlinia, RESTART);
nResult4 = FileGrep(szFile,"NoExecute=OptIn", svlinia, nvlinia, RESTART);

if ((nResult1 = 0)||(nResult2 = 0)) then
nWynik = 1;
if bLog then WriteLog(0,"* Włączona funkcja DEP w systemie Windows!"); endif;
elseif ((nResult3 = 0)||(nResult4 = 0)) then
nWynik = 0;
if bLog then WriteLog(0,"* Wyłączona funkcja DEP w systemie Windows!"); endif;
else
if bLog then WriteLog(0,"* Funkcja DEP - brak możliwości sprawdzenia"); endif;
nWynik = -1;
endif;

return nWynik;
end;
Posted by Przemas o października 28, 2009 0 komentarze
Etykiety:

wtorek, 27 października 2009

Podmiana obrazów w znaczniku html img

fname - ID pole formularza zawierające ścieżkę i nazwę pliku
img - ID znacznika img

function CapturePath(fname,img)
{
if (document.getElementById(img))
{
oImg = document.getElementById(img);
if (/Firefox[\/\s](\d+\.\d+)/.test(navigator.userAgent))
{
if (document.getElementById(fname).files[0]) {
oImg.src=document.getElementById(fname).files[0].getAsDataURL();
}
} else {
if (document.getElementById(fname)) {
pic = document.getElementById(fname);
oImg.src=pic.value;
}
}
}
}
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Obliczenie CRC32

Definicja nagłówka crc32.h:

#ifndef Crc32H
#define Crc32H
#endif
#include
class CCrc32
{
public:
CCrc32();
virtual ~CCrc32();

void Init(void);
void Free(void);

unsigned long int FileCrc32(AnsiString FileName);
AnsiString FileCrc32Hex(AnsiString FileName);
private:
unsigned long int *crc32_tab;
};


Implementacja: crc32.cpp

#pragma hdrstop
#include "Crc32.h"
#include
#include
#define BUFSIZE 8192

#pragma package(smart_init)
CCrc32::CCrc32()
{
}

CCrc32::~CCrc32()
{
Free();
}

void CCrc32::Free(void)
{
delete[] crc32_tab;
}

void CCrc32::Init(void)
{
// Often times the polynomial shown reversed as 0x04C11DB7.
unsigned long int dwPolynomial = 0xEDB88320;

int i = 0, j = 0;

crc32_tab = new unsigned long int[256];
unsigned long int dwCrc;

for(i = 0; i < 256; i++) { dwCrc = i; for(j = 8; j > 0; j--)
{
if(dwCrc & 1)
dwCrc = (dwCrc >> 1) ^ dwPolynomial;
else
dwCrc >>= 1;
}
crc32_tab[i] = dwCrc;
}

}

unsigned long int CCrc32::FileCrc32(AnsiString FileName)
{
FILE *file = NULL;
unsigned char buf[BUFSIZE];
unsigned long int crc32 = 0;
size_t i = 0, n = 0;

if(!(file = fopen(FileName.c_str(), "rb")))
{
return -1;
}

fseek(file, 0, SEEK_SET);

crc32 = 0xffffffff;

while((n = fread(buf, 1, BUFSIZE, file)) > 0)
{
for(i = 0; i < n; i++) crc32 = (crc32 >> 8) ^ crc32_tab[(crc32 & 0xff) ^ buf[i]];
}

crc32 ^= 0xffffffff;

fclose(file);


return crc32;
}

AnsiString CCrc32::FileCrc32Hex(AnsiString FileName)
{
unsigned long int wynik;
AnsiString szHex;
wynik = FileCrc32(FileName);

TVarRec vr[] = { wynik };
szHex = Format("%X",vr,1);
if (szHex.Length()<8) { for (int i = szHex.Length(); i < 8; i++) szHex ="0" +szHex; } szHex ="0x"+szHex; return szHex; }
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Funkcja odczytująca wersję pliku 

function BOOL ReadFileVersion(svPathFile, svVersion )
int nResult;
begin
 if (Is (FILE_EXISTS,svPathFile)) then
  nResult = VerGetFileVersion(svPathFile,svVersion); 
  switch (nResult) 
   case  0: return TRUE;
   case -2: svVersion="-1"; return FALSE; //no file
   case -8: svVersion="0";  return FALSE;  //brak informacji o pliku
  endswitch;
 else  
  return FALSE; //Plik nie istnieje;
 endif;
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

funkcja sprawdzająca czy podany ciąg znaków jest adresem IPv4 

function BOOL IsIPAdres(szIP)
BOOL bResult;
string tab,adr;         
string znak;
number lista;                               
INT i,nadr;
begin        
 bResult = TRUE;
 tab = "0123456789.";
 lista = ListCreate(STRINGLIST);
 //Sprawdzenie ilosci znakow
 if ((StrLength(szIP)<7) || (StrLength(szIP)>15)) then bResult = FALSE; endif;
 //sprawdzenie dozwolonych znakow
 for i=0 to (StrLength(szIP)-1) 
  StrSub(znak,szIP,i,1);
  if (StrFind(tab,znak)<0) then bResult = FALSE; endif;
 endfor;
 //Rozdzielenie na liste adresow
 StrGetTokens ( lista, szIP, "." ); 
 //Czy lista sklada sie z 4 pozycji
 if (ListCount(lista)!=4) then bResult = FALSE; endif; 
 //Sprawdzenie poszczegolnych elementow listy czy format poprawny 
 ListSetIndex(lista,LISTFIRST);
    for i=0 to ListCount(lista)-1  
      ListCurrentString ( lista, adr );
      if ((StrLength(adr)>3) || (StrLength(adr)=0)) then bResult = FALSE; endif;
      //Jezeli na pierwszym miejscu jest 0 
      if ((StrLength(adr)>1)&&(adr[0]=="0")) then bResult = FALSE; endif;   
      //Jezeli nie da sie zamienic na liczbe
      if (StrToNum(nadr,adr)<0) then 
       bResult = FALSE; 
      else //Jezeli wynik jest wiekszy niz 256
       if (nadr>256) then bResult = FALSE; endif;      
      endif;   
      ListSetIndex (lista, LISTNEXT);
    endfor;         
    
 ListDestroy(lista);
 
 return bResult;
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

funkcja TRIM - spacje 

function string StrTrim(svString)
int i,len;
string sLeft,sRight;
begin 
 len = StrLength(svString);
 if (len>0) then 
  i=0;       
  //zLewej
  while ((svString[i]==" ")||(i>=len))                   
   i++;
   endwhile;              
   if (len>i) then 
    StrSub(sLeft,svString,i,len); 
   else
    sLeft = svString; 
   endif;                
 else                 
  sLeft = svString; 
 endif;            
                    
 len = StrLength(sLeft);
 if (len>0) then
  i=len-1;
  while ((i>=0)&&(sLeft[i]==" "))
   i--;
  endwhile;                
  if (i>=0) then
   StrSub(sRight,sLeft,0,i+1); 
  else
   sRight = ""; 
  endif;
 else
  sRight = sLeft; 
 endif;                                   
 
 return sRight; //Obciety z lewej i prawej
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Potęga liczby 

function potega(liczba,wykladnik)
number i,nResult;
begin           
 nResult=0;
 if (wykladnik>0) then  
  nResult=1;                 
  for i=1 to wykladnik 
   nResult=nResult*liczba;
  endfor;   
 else  
  nResult = 1;
 endif;       
return nResult; 
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Pobranie ścieżki danych serwera MSSQL

Jeżeli funkcja zwróci TRUE to do zmiennej svPath - zostanie przekazana ścieżka 
function BOOL GetMSSQLPath(sServerName, sDBName, svPath, sDriver, bTrustedConn, sUserName, sUserPwd)
 OBJECT objConn, objRST;     
 STRING  szADOConnObjID;
 STRING sTekst, sConnString, sDBFileName;
 BOOL bReturn;
begin
 bReturn = FALSE;
 
 // Create the connectionstring
    if (sDriver == "") then
     sConnString = "Provider=sqloledb;";
    else
     sConnString = "Driver={" + sDriver + "};";
    endif;

 if (bTrustedConn) then
  //ACA_Log_AppendLine("   using Windows Authentication");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "database=" + sDBName + ";";
  sConnString = sConnString + "Trusted_connection=Yes";
 else
  //ACA_Log_AppendLine("   using SQL Login");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "uid=" + sUserName + ";";
  sConnString = sConnString + "pwd=" + sUserPwd + ";";
  sConnString = sConnString + "database=" + sDBName;
 endif;
 
  szADOConnObjID = "ADODB.Connection";
     set objConn = CreateObject(szADOConnObjID);         
 
        if (IsObject(objConn)) then 
  
   objConn.ConnectionString = sConnString;
   objConn.Open;        
   
   set objRST = objConn.Execute("select filename from sysfiles where filename like '%.mdf%' ");
   sDBFileName = objRST("filename");                                           
   ParsePath ( svPath, sDBFileName, PATH );       
   if (StrFind(svPath,"data\\")>0) then
    StrSub(svPath,svPath,0,StrFind(svPath,"data\\"));
   endif;                                        
   
   objConn.Close;   
   bReturn  = TRUE;   
     
  endif;
  
  set objConn = NOTHING;
  set objRST  = NOTHING;
  
 return (bReturn); 
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Wykonanie skryptu SQL z pliku 

function BOOL ExecuteSQLScript(szFile, sServerName, sDBName, sDriver, bTrustedConn, sUserName, sUserPwd, bLog)
OBJECT objConn, objRST, pADORecordSetObj, adoCommand; 
STRING sConnString, szADOConnObjID, szADORecordSetObjID; 
BOOL bReturn, bOpenCon;
LIST ListaSQL;
INT i;
STRING szLine, szSQL;
begin                                  
 bReturn = TRUE;    
 bOpenCon = FALSE;
 // Create the connectionstring
    if (sDriver == "") then sConnString = "Provider=sqloledb;";
           else sConnString = "Driver={" + sDriver + "};";
    endif;

 if (bTrustedConn) then //ACA_Log_AppendLine("   using Windows Authentication");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "database=" + sDBName + ";";
  sConnString = sConnString + "Trusted_connection=Yes";
 else //ACA_Log_AppendLine("   using SQL Login");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "uid=" + sUserName + ";";
  sConnString = sConnString + "pwd=" + sUserPwd + ";";
  sConnString = sConnString + "database=" + sDBName;
 endif;

 try
  szADOConnObjID = "ADODB.Connection";
     set objConn = CreateObject(szADOConnObjID);         
   
  if (IsObject(objConn)) then 
   objConn.ConnectionString = sConnString;
   objConn.Open;                            
   bOpenCon = TRUE;      //Połączono 
  else
   if (bLog) then WriteLog(1,"Nie moża utworzyć obiektu połączenia ADODB.Connection do "+sDBName); endif;  
  endif;
    
  
 catch             
  bOpenCon = FALSE;
  bReturn = FALSE;
  if (bLog) then WriteLog(1,"Nie uzyskano połączenia z bazą "+sDBName); endif;  
 endcatch;
 
 
if (bOpenCon) then  //Jezeli połączono to odczytaj plik i wykonaj skrypty

 szSQL = "";
 ListaSQL = ListCreate(STRINGLIST);
 if Is(FILE_EXISTS,szFile) then                  
               
  ListReadFromFile(ListaSQL,szFile);                           //Odczytanie pliku do listy
  ListSetIndex(ListaSQL,LISTFIRST);
  for i = 0 to ListCount(ListaSQL)-1 
      ListCurrentString(ListaSQL, szLine);                     //linia po linii 
      if StrLength(szLine)>0 then
       if (StrLength(szLine)=2)&&(StrFind(szLine,"GO")>=0) then 
        //Wykonanie skryptu
        try
            set objRST = objConn.Execute(szSQL);      
            if (bLog) then 
             WriteLog(1,"- SQL: \""+szSQL+"\"");             
            endif; 
           catch             
            if (bLog) then 
             WriteLog(1,"- Błąd wykonania SQL: ");
             WriteLog(2,"\""+szSQL+"\"");
            endif;                       
            bReturn = FALSE;
           endcatch;                         
          
           szSQL = "";
       else
          //dopisywanie linii do postaci sql
          if StrLength(szSQL)>0 then szSQL = szSQL + " " + szLine; 
                          else szSQL = szLine;
          endif;      
       endif;    
      endif; //StrLength = 0; 
   
   ListSetIndex(ListaSQL,LISTNEXT);   
  endfor;
 
 else  
  if (bLog) then WriteLog(1,"- brak pliku skryptu SQL"); endif;
 endif;                
 
 ListDestroy(ListaSQL);
 set objConn = NOTHING;
 set objRST  = NOTHING;
 
 endif; //bOpen - połączono; 
 
 return bReturn;
 
end;
Posted by Przemas o października 27, 2009 1 komentarze
Etykiety:

Hex to Dec 

function string HexToDec(sHex)
number i,nResult,nLiczba;
string sChar,sResult;
begin           
 nResult=0;
 for i=0 to (StrLength(sHex)-1)
  nLiczba=0;                 
  StrSub(sChar,sHex,i,1);
     StrToNum(nLiczba,sChar);
     nLiczba=nLiczba*potega(16,(StrLength(sHex)-1-i));
  nResult=nResult+nLiczba;
 endfor;            
 NumToStr(sResult,nResult);             
 return sResult; 
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

ExecuteSQL

Wykonanie zapytania SQL lub procedury
function BOOL ExecuteSQL(sSQL, sServerName, sDBName, sDriver, bTrustedConn, sUserName, sUserPwd, bLog, bQuery)
 OBJECT objConn, objRST, pADORecordSetObj,adoCommand; 
 STRING sTekst, sConnString;         
 STRING  szADOConnObjID,szADORecordSetObjID; 
 STRING szError;
BOOL bReturn;
begin
 bReturn = FALSE;
 
 // Create the connectionstring
    if (sDriver == "") then
     sConnString = "Provider=sqloledb;";
    else
     sConnString = "Driver={" + sDriver + "};";
    endif;

 if (bTrustedConn) then
  //ACA_Log_AppendLine("   using Windows Authentication");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "database=" + sDBName + ";";
  sConnString = sConnString + "Trusted_connection=Yes";
 else
  //ACA_Log_AppendLine("   using SQL Login");
     sConnString = sConnString + "server=" + sServerName + ";";
  sConnString = sConnString + "uid=" + sUserName + ";";
  sConnString = sConnString + "pwd=" + sUserPwd + ";";
  sConnString = sConnString + "database=" + sDBName;
 endif;
 
 try
  szADOConnObjID = "ADODB.Connection";
     set objConn = CreateObject(szADOConnObjID);         
    
  if (IsObject(objConn)) then 
 
   objConn.ConnectionString = sConnString;
   objConn.Open;                          
  
   if (!bQuery) then  //Jeżeli to Execute SQL a nie Query   
    set objRST = objConn.Execute(sSQL);      
    bReturn  = TRUE;
   else      
    // Create ADO Recordset object for the return         
    
    szADORecordSetObjID = "ADODB.Recordset";
    set pADORecordSetObj = CreateObject(szADORecordSetObjID);
    
    pADORecordSetObj.CursorType = 3;    
    pADORecordSetObj.ActiveConnection = objConn;    
    pADORecordSetObj.Open(sSQL);    
    if ((pADORecordSetObj.RecordCount >= 1)||(pADORecordSetObj.RecordCount = -1)) then
     bReturn = TRUE;
    else
      bReturn = FALSE; 
    endif;             
    
    set pADORecordSetObj = NOTHING;
   endif;
  else
   if (bLog) then WriteLog(1,"Nie moża utworzyć obiektu połączenia ADODB.Connection do "+sDBName); endif;  
  endif;
  
  set objConn = NOTHING;
  set objRST  = NOTHING;
  
 catch  
  if (bLog) then WriteLog(1,"Błąd wykonania zapytania SQL"); endif;  
 endcatch;
 
 return (bReturn);
end;
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Operowanie blokiem

Czasami zachodzi konieczność ukrycia bloku lub jego pokazanie.

function ShowBlock(block_id)
{
el = document.getElementById(block_id);
el.style.display = 'block';
}

function HideBlock(block_id)
{
el = document.getElementById(block_id);
el.style.display = 'none';
}
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Usuwanie elementu ze strony

Usunięcie wybranego elementu ze strony o nadanym atrybucie ID

function RemoveEl(szName){
var el = document.getElementById(szName);
while (el) {
document.body.removeChild(el);
el = document.getElementById(szName);
}
}
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

Pobranie szerokości i wysokości "body" przeglądarki

Jeżeli zajdzie potrzeba pobrania szerokości lub wysokości "ciała" przeglądarki(bez menu, pasków narzędzi, pasków przewijania), można skorzystać z poniższych funkcji.

function browserWidth() {
var myWidth = 0;
if( typeof( window.innerWidth ) == 'number' ) {
//Non-IE
myWidth = document.documentElement.clientWidth;
} else if( document.documentElement && document.documentElement.clientWidth ) {
//IE 6+ in 'standards compliant mode'
myWidth = document.documentElement.clientWidth;
} else if( document.body && document.body.clientWidth ) {
//IE 4 compatible
myWidth = document.body.clientWidth;
}
return myWidth;
}

function browserHeight() {
   var myHeight = 0;
   if( typeof( window.innerWidth ) == 'number' ) {
       //Non-IE
       myHeight = document.documentElement.clientHeight;
   } else if( document.documentElement && document.documentElement.clientHeight )    {
        //IE 6+ in 'standards compliant mode'
        myHeight = document.documentElement.clientHeight;
     } else if( document.body && document.body.clientHeight ) {
           //IE 4 compatible
           myHeight = document.body.clientHeight;
     }
     return myHeight;
}
Posted by Przemas o października 27, 2009 1 komentarze
Etykiety:

Pauza wykonywania skryptu

Czasami jest potrzeba zatrzymania wykonywania skryptu na określony czas.
Nie jest to może najlepszy sposób, bo obciąża znacznie procesor, ale czasami niezbędny i jedyny.

function pause(ms){
var date = new Date();
curDate = null;
do{var curDate = new Date();}
while( curDate - date < ms); }
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:

funkcje typu TRIM na łańcuchach

Obcięcie z lewej i z prawej strony łańcucha o określone znaki

function trim(str, chars) {
return ltrim(rtrim(str, chars), chars);
}

Obcięcie z lewej strony łańcucha o określone znaki

function ltrim(str, chars) {
chars = chars || "\\s";
return str.replace(new RegExp("^[" + chars + "]+", "g"), "");
}

Obcięcie z prawej strony łańcucha o określone znaki

function rtrim(str, chars) {
chars = chars || "\\s";
return str.replace(new RegExp("[" + chars + "]+$", "g"), "");
}
Posted by Przemas o października 27, 2009 0 komentarze
Etykiety:
Subskrybuj: Posty (Atom)