CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg
Cookie ikon
Avatar billede intersurf Nybegynder
04. juni 2001 - 14:10 Der er 12 kommentarer

Mata-crawler

Er der nogen der vil pakke denne meta crawler ned i filer og sende dem til jens@jespersen.as og de skal virke lige så snart man oploader dem!!!




<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">

<html>
<head>
    <title>Untitled</title>
</head>

<body>

<SCRIPT LANGUAGE=JSCRIPT RUNAT=SERVER>
  /*
 
      HTTPSocket
      by Joshua J Baker - josh@cobaltcreative.com
      Designed for the Socket.dll by Dimac
     
  */
 
  function HTTPSocket_2(URL){
      /* Define the main properties */
      this.URL = URL;
      this.Port = 80;
      this.Method = \"GET\";
      this.Protocol = \"HTTP\";
      this.Headers = new Object();
      this.FullContent = \"\";
      this.Head = \"\";
      this.Content = \"\";
      this.SendBuffer = \"\";
      this.StoreBuffer = \"\";
      this.Version = \"1.0\";
      this.TimeOut = 10000;
     
      /* Parse the URL */     
      URL = URL.split(\":\");
      switch (URL.length) {
        case 3:
        this.Protocol = URL[0].toUpperCase ();
            this.Host = URL[1].indexOf(\"//\")==0?URL[1].substring(2).split(\"/\")[0]:URL [0];
          this.Port = parseInt(URL[2]).toString ();
            this.Query = URL[2].substring (this.Port.length);
      break;
        case 2:
        this.Host = URL[1].indexOf(\"//\")==0?URL[1].substring(2).split(\"/\")[0]:URL [0];
          this.Protocol = (URL[1].indexOf(\"//\")==0?URL[0]:this.Protocol).toUpperCase ();
            this.Port = URL[1].indexOf(\"//\")==0?this.Port:parseInt(URL[1]).toString ();
            this.Query = URL[1].indexOf(\"//\")==0?URL[1].substring(2+this.Host.length): (URL[1].split(\"/\").length>1?URL[1].substring (this.Port.length):\"/\");
    break;
        case 1:
        this.Host = URL[0].split(\"/\")[0]
        this.Query = URL[0].indexOf(\"/\")<URL[0].length-1&&URL [0].indexOf(\"/\")!=-1?URL[0].substring (this.Host.length):\"/\";
      }
     
      this.AddHeader = function(Name, Value){
        this.Headers[Name] = Value;
      }
     
      this.RemoveHeader = function(Name) {
        this.Headers[Name] = false;
      }
     
      this.Execute = function() {
        this.SendBuffer = this.Method + \" \" + this.Query + \" \" + this.Protocol + \"/\" + this.Version + \"n\";
        for (prop in this.Headers)
        this.SendBuffer += !this.Headers[prop]?\"\":prop + \": \" + this.Headers[prop] + \"n\";
        this.SendBuffer += \"n\";
        var Socket = Server.CreateObject (\"Socket.TCP\");
          Socket.TimeOut = this.TimeOut;
      Socket.Host = this.Host + \":\" + this.Port;
        Socket.Open ();
        Socket.SendText (this.SendBuffer);
Socket.WaitForDisconnect ();
        this.StoreBuffer = Socket.Buffer;
    Socket.Close ();
        var j = this.StoreBuffer.indexOf(\"nrn\"), k = this.StoreBuffer.indexOf (\"nn\");
        this.Head = ((j < k && j > -1)||(j > -1 && k == -1))?this.StoreBuffer.substring(0, j - 1):((k < j && k > -1)||(k > -1 && j == -1))?this.StoreBuffer.substring(0, k):this.StoreBuffer;
    this.Content = ((j < k && j > -1)||(j > -1 && k == -1))?this.StoreBuffer.substring(j + 3):((k < j && k > -1)||(k > -1 && j == -1))?this.StoreBuffer.substring(k + 3):this.StoreBuffer;
    return this.Content;
      }
  }
 
  function HTTPSocket(URL){
      /* For creating a HTTPSocket in VBScript */
      return new HTTPSocket_2(URL);
  }




</SCRIPT>

<%
Set Sock = HTTPSocket(\"www.altavista.com\")
Sock.AddHeader \"User-Agent\", \"My Browser\"
output = Sock.Execute()
oldoutput = output
output = LCase(output)


do while not AtEndOfSearch
if temppos = \"\" then
temppos = 1
end if

startpos = InStr(temppos, output, \"<meta\")

if startpos <> 0 then
endpos = InStr(startpos, output, \">\")
if endpos <> 0 then

curmetatag = Mid(output, startpos, endpos-startpos+1)
if InStr(curmetatag, \"description\") <> 0 then

metastart = InStr(curmetatag, \"content\")
if metastart <> 0 then
metaend = InStr(metastart, curmetatag, \">\")
if metaend <> 0 then
metastart = metastart + 9
curmetawords = Mid(curmetatag, metastart, metaend - metastart-1)
response.write \"<b>meta-description:</b> \" & curmetawords & \"<br><br>\"
end if
end if

else
if InStr(curmetatag, \"keywords\") <> 0 then

metastart = InStr(curmetatag, \"content\")
if metastart <> 0 then
metaend = InStr(metastart, curmetatag, \">\")
if metaend <> 0 then
metastart = metastart + 9
curmetawords = Mid(curmetatag, metastart, metaend - metastart-1)
response.write \"<b>meta-keywords:</b> \" & curmetawords & \"<br><br>\"
end if
end if


end if
end if


temppos = endpos
end if
else
AtEndOfSearch = True
end if

loop


startpos = InStr(output, \"<title>\")
if startpos <> 0 then
endpos = InStr(output, \"</title>\")
if endpos <> 0 then
curtitle = Mid(oldoutput, startpos+7, endpos-startpos)
response.write \"<b>titel:</b> \" & curtitle & \"<br><br>\"
end if
end if
%>

</body>
</html>
Avatar billede intersurf Nybegynder
04. juni 2001 - 14:13 #1
Alså sådan AT der er en forside der er et søge feldt på!!!!!
Avatar billede intersurf Nybegynder
04. juni 2001 - 14:40 #2
OKAY så får i 50 point mere!!!!!!!
Avatar billede Christian V. Dalsgaard Nybegynder
04. juni 2001 - 14:43 #3
Har du installeret den der server komponent der hedder: Socket.TCP ??

Avatar billede Christian V. Dalsgaard Nybegynder
04. juni 2001 - 14:44 #4
eller registreret Socket.dll , hvis det skal være helt korekt..
Avatar billede intersurf Nybegynder
04. juni 2001 - 14:47 #5
Er der det på azero ??????
Avatar billede intersurf Nybegynder
04. juni 2001 - 14:48 #6
Kan man få et gratis webhotel med Socket.TCP på?
Avatar billede Christian V. Dalsgaard Nybegynder
04. juni 2001 - 15:05 #7
Men lad os finde ud af det, smid dette op på serveren:

smid evt. et link til mig på cd@vestdata.dk

<%
\'*** Server Status v1.0 ***
\'*** af Lars Snyder (pila@mailme.dk) ***
\'*** http://www.tipsogtricks-online.dk ***
\'*
\'* Sprog: VBScript
\'*
\'* Nedenstående rutiner kan bruges til at få overblik over serverens status.
\'* Dette er specielt godt, hvis man kører ASP på et Web-Hotel - fordi man ikke
\'* altid selv er herre over hvilke komponent- og softwareversioner der installeres.
\'Konstanter til at styre tabel layout
Public Const TAB_TABLE = \"<TABLE BORDER=0 CELLPADDING=3 CELLSPACING=1 BGCOLOR=\"\"#66AAFF\"\" width=\"\"400\"\">\"
Public Const TAB_TR = \"<TR>\"
Public Const TAB_FONT = \"<FONT FACE=\"\"verdana\"\" SIZE=1>\"
Public Const TAB_TD = \"<TD BGCOLOR=\"\"#FFFFFF\"\">\"
Public Const TAB_TDR = \"<TD BGCOLOR=\"\"#FFFFFF\"\" ALIGN=\"\"RIGHT\"\">\"
Public Const TAB_IFONT = \"</FONT>\"
Public Const TAB_ITD = \"<BR></TD>\"
Public Const TAB_ITR = \"</TR>\"
Public Const TAB_ITABLE = \"</TABLE>\"

\'Kør de forskellige info funktioner og vis tabellerne
Response.Write \"<H2>Server Status</H2>\"
Response.Write \"<table border=\"\"0\"\" width=\"\"100%\"\"><tr valign=\"\"top\"\"><td>\"
%>


<%
\' Det antal dage som skal vises som nye
CONST intDays = 7

\' Den mappe som funktionen skal kigge i
tmpPath = Server.MapPath(\"/\")

Set objFSO = Server.CreateObject(\"Scripting.FileSystemObject\")
Set objFolder = objFSO.GetFolder(tmpPath)
Set arrFile = objFolder.Files

Response.Write \"<TABLE BORDER=0 CELLPADDING=3 CELLSPACING=1 BGCOLOR=\"\"#66AAFF\"\" width=\"\"400\"\">\"
Response.Write \"<td colspan=\"\"2\"\"><FONT FACE=\"\"verdana\"\" SIZE=1><b>Oversigt over filer som er opdateret inden for de sidste \" & intDays & \" dage</b></td>\"
Response.write \"<tr><td><FONT FACE=\"\"verdana\"\" SIZE=1>Navn på filen</td><td><FONT FACE=\"\"verdana\"\" SIZE=1>Sidst opdateret</td></tr>\"

\' Her looper vi gennem alle filer i denne mappe
For Each File In arrFile
  tmpFile = File.Name
  dtmLastUpdated = File.DateLastModified
 
  \' Kun ASP filer skal vises som nye
  If (LCase((Right(tmpFile, 3)) = \"asp\") And (dtmLastUpdated > Date - intDays)) OR (LCase((Right(tmpFile, 4)) = \"html\") And (dtmLastUpdated > Date - intDays)) OR (LCase((Right(tmpFile, 3)) = \"htm\") And (dtmLastUpdated > Date - intDays)) Then
    Response.Write \"<tr><td BGCOLOR=\"\"#FFFFFF\"\"><FONT FACE=\"\"verdana\"\" SIZE=1><a href=\"\"/\" & tmpFile & \"\"\">\" & tmpFile & \"</a></td>\"
    Response.Write \"<td width=\'50%\' BGCOLOR=\"\"#FFFFFF\"\"><FONT FACE=\"\"verdana\"\" SIZE=1>\" & FormatDateTime(dtmLastUpdated, vbLongDate) & \"</td></tr>\"
  End If
Next
Response.Write \"</table><br>\"

Set objFS = Nothing
%>




<%
Response.Write ServerInfo
Response.Write GlobalInfo
Response.Write ScriptingInfo
Response.Write \"</td><td>\"
Response.Write ComponentInfo
Response.Write ADOInfo
Response.Write DriveInfo
Response.Write \"</td></tr></table>\"
Response.Write \"<P><FONT SIZE=1>Server Status v1.0 af Lars Snyder [pila@mailme.dk]</FONT>\"

\'*** Funktion der returnerer tabel-streng med oplysninger om serveren ***
Public Function ServerInfo()
\'Header
ServerInfo = TAB_TABLE
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & \"<TD COLSPAN=2>\" & TAB_FONT & \"<B>Oplysninger om serveren</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Navn og adresse
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Navn og adresse</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Request.ServerVariables(\"SERVER_NAME\") & \" (\" & Request.ServerVariables(\"LOCAL_ADDR\") & \")\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Fysisk rodmappe
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Fysisk rodmappe</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Request.ServerVariables(\"APPL_PHYSICAL_PATH\") & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Dato og tid
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Dato og tid</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT
ServerInfo = ServerInfo & FormatDateTime(Now(), vbGeneralDate) & \" (vbGeneralDate)\" & \"<BR>\"
ServerInfo = ServerInfo & FormatDateTime(Now(), vbLongDate) & \" (vbLongDate)\" & \"<BR>\"
ServerInfo = ServerInfo & FormatDateTime(Now(), vbShortDate) & \" (vbShortDate)\" & \"<BR>\"
ServerInfo = ServerInfo & FormatDateTime(Now(), vbLongTime) & \" (vbLongTime)\" & \"<BR>\"
ServerInfo = ServerInfo & FormatDateTime(Now(), vbShortTime) & \" (vbShortTime)\"
ServerInfo = ServerInfo & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Software
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Software</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Request.ServerVariables(\"SERVER_SOFTWARE\") & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Script Engine ID
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Script Engine ID</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & ScriptEngine & \" v\" & ScriptEngineMajorVersion & \".\" & ScriptEngineMinorVersion & \" (Build \" & ScriptEngineBuildVersion & \")\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Protokol
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Protokol</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Request.ServerVariables(\"SERVER_PROTOCOL\") & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Gateway
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Gateway</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Request.ServerVariables(\"GATEWAY_INTERFACE\") & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

\'Timeout
ServerInfo = ServerInfo & TAB_TR
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & \"<B>Timeout</B>\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_TD & TAB_FONT & Server.ScriptTimeout & \" sekunder (Script)\" & \"<BR>\"
ServerInfo = ServerInfo & Session.Timeout & \" minutter (Session)\" & TAB_IFONT & TAB_ITD
ServerInfo = ServerInfo & TAB_ITR

ServerInfo = ServerInfo & TAB_ITABLE
ServerInfo = ServerInfo & \"&nbsp;<BR>\"
End Function

\'*** Funktion der returnerer tabel-streng med oplysninger om objekter i global.asa ***
Public Function GlobalInfo()
\'Header
GlobalInfo = TAB_TABLE
GlobalInfo = GlobalInfo & TAB_TR
GlobalInfo = GlobalInfo & \"<TD COLSPAN=2>\" & TAB_FONT & \"<B>Oplysninger om objekter i global.asa</B>\" & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_ITR

\'Tools
GlobalInfo = GlobalInfo & TAB_TR
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT & \"<B>Tools</B>\" & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT
If IsGlobal(\"Tools\") Then
GlobalInfo = GlobalInfo & TypeName(Tools)
Else
GlobalInfo = GlobalInfo & \"?\"
End If
GlobalInfo = GlobalInfo & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_ITR

\'MyInfo
GlobalInfo = GlobalInfo & TAB_TR
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT & \"<B>MyInfo</B>\" & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT
If IsGlobal(\"MyInfo\") Then
GlobalInfo = GlobalInfo & TypeName(MyInfo)
Else
GlobalInfo = GlobalInfo & \"?\"
End If
GlobalInfo = GlobalInfo & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_ITR

\'Counters
GlobalInfo = GlobalInfo & TAB_TR
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT & \"<B>Counters</B>\" & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_TD & TAB_FONT
If IsGlobal(\"Counters\") Then
GlobalInfo = GlobalInfo & TypeName(Counters)
Else
GlobalInfo = GlobalInfo & \"?\"
End If
GlobalInfo = GlobalInfo & TAB_IFONT & TAB_ITD
GlobalInfo = GlobalInfo & TAB_ITR

GlobalInfo = GlobalInfo & TAB_ITABLE
GlobalInfo = GlobalInfo & \"&nbsp;<BR>\"
End Function

\'*** Funktion der returnerer tabel-streng med oplysninger om Scripting klasser ***
Public Function ScriptingInfo()
\'Header
ScriptingInfo = ScriptingInfo & TAB_TABLE
ScriptingInfo = ScriptingInfo & TAB_TR
ScriptingInfo = ScriptingInfo & \"<TD COLSPAN=2>\" & TAB_FONT & \"<B>Oplysninger om Scripting klasser</B>\" & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_ITR

\'Scripting.Dictionary
ScriptingInfo = ScriptingInfo & TAB_TR
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & \"<B>Scripting.Dictionary</B>\" & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & ClassCreateObject(\"Scripting.Dictionary\") & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_ITR

\'Scripting.FileSystemObject
ScriptingInfo = ScriptingInfo & TAB_TR
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & \"<B>Scripting.FileSystemObject</B>\" & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & ClassCreateObject(\"Scripting.FileSystemObject\") & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_ITR

\'ADODB.Connection
ScriptingInfo = ScriptingInfo & TAB_TR
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & \"<B>ADODB.Connection</B>\" & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_TD & TAB_FONT & ClassCreateObject(\"ADODB.Connection\") & TAB_IFONT & TAB_ITD
ScriptingInfo = ScriptingInfo & TAB_ITR

ScriptingInfo = ScriptingInfo & TAB_ITR
ScriptingInfo = ScriptingInfo & TAB_ITABLE
ScriptingInfo = ScriptingInfo & \"&nbsp;<BR>\"
End Function

\'*** Funktion der returnerer tabel-streng med oplysninger om Server komponenter ***
\'* Tilføj selv flere relevante komponenter
Public Function ComponentInfo()
\'Header
ComponentInfo = ComponentInfo & TAB_TABLE
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & \"<TD COLSPAN=2>\" & TAB_FONT & \"<B>Oplysninger om Server komponenter</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'Header2
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B><I>Microsoft ASP</I></B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"&nbsp;\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'MSWC.AdRotator
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Ad Rotator (MSWC.AdRotator)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.AdRotator\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'MSWC.BrowserType
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Browser Capabilities (MSWC.BrowserType)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.BrowserType\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'ADODB.Connection
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Database Access (ADODB.Connection)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"ADODB.Connection\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'MSWC.NextLink
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Content Linking (MSWC.NextLink)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.NextLink\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'Scripting.FileSystemObject
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>File Access (Scripting.FileSystemObject)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"Scripting.FileSystemObject\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'CDONTS.Session
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>CDO for NTS (CDONTS.Session)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"CDONTS.Session\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

If Not IsGlobal(\"Tools\") Then \'Undgå at smadre evt. eksisterende objekt
\'MSWC.Tools
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Tools (MSWC.Tools)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.Tools\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR
End If

\'MSWC.Status
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Status (MSWC.Status)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.Status\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

If Not IsGlobal(\"MyInfo\") Then \'Undgå at smadre evt. eksisterende objekt
\'MSWC.MyInfo
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>MyInfo (MSWC.MyInfo)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.MyInfo\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR
End If

If Not IsGlobal(\"Counters\") Then \'Undgå at smadre evt. eksisterende objekt
\'MSWC.Counters
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Counters (MSWC.Counters)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.Counters\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR
End If

\'MSWC.PageCounter
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Page Counter (MSWC.PageCounter)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.PageCounter\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'MSWC.PermissionChecker
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Permission Checker (MSWC.PermissionChecker)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"MSWC.PermissionChecker\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'Header3
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B><I>Komponenter fra tredjemand</I></B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"&nbsp;\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'ASPMail.ASPMailCtrl.1
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>OCXMail fra Flicks Software (ASPMail.ASPMailCtrl.1)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"ASPMail.ASPMailCtrl.1\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'ASPChart.Chart
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>ASP Chart fra ServerObjects (ASPChart.Chart)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"ASPChart.Chart\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'JMail.SMTPMail
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>JMail fra Dimac (JMail.SMTPMail)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"JMail.SMTPMail\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'SoftArtisans.FileUp
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>SA-FileUp fra SoftArtisans (SoftArtisans.FileUp)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"SoftArtisans.FileUp\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'cyScape.browserObj
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>Browserhawk fra CyScape (cyScape.browserObj)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"cyScape.browserObj\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'SMTPsvg.Mailer
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>ASPMail fra ServerObjects (SMTPsvg.Mailer)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"SMTPsvg.Mailer\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'AspHTTP.Conn
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>ASPHttp fra ServerObjects (AspHTTP.Conn)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"AspHTTP.Conn\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'Socket.TCP
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>w3 Sockets fra Dimac (Socket.TCP)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"Socket.TCP\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'POP3svg.Mailer
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>ASPPop3 fra ServerObjects (POP3svg.Mailer)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"POP3svg.Mailer\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

\'InetCtls.Inet
ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>HTTP Rip fra Microsoft (InetCtls.Inet)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"InetCtls.Inet\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

ComponentInfo = ComponentInfo & TAB_TR
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & \"<B>HTTP Rip fra Microsoft (InetCtls.Inet)</B>\" & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_TD & TAB_FONT & ServerCreateObject(\"InetCtls.Inet\") & TAB_IFONT & TAB_ITD
ComponentInfo = ComponentInfo & TAB_ITR

ComponentInfo = ComponentInfo & TAB_ITR
ComponentInfo = ComponentInfo & TAB_ITABLE
ComponentInfo = ComponentInfo & \"&nbsp;<BR>\"
End Function

\'*** Funktion der returnerer tabel-streng med oplysninger om ADO ***
Public Function ADOInfo()
Dim objConn

\'ADO Connection
Set objConn = Server.CreateObject(\"ADODB.Connection\")

\'Header
ADOInfo = TAB_TABLE
ADOInfo = ADOInfo & TAB_TR
ADOInfo = ADOInfo & \"<TD COLSPAN=2>\" & TAB_FONT & \"<B>Oplysninger om ADO Connection</B>\" & TAB_IFONT & TAB_ITD
ADOInfo = ADOInfo & TAB_ITR

\'Provider
ADOInfo = ADOInfo & TAB_TR
ADOInfo = ADOInfo & TAB_TD & TAB_FONT & \"<B>Provider</B>\" & TAB_IFONT & TAB_ITD
ADOInfo = ADOInfo & TAB_TD & TAB_FONT & objConn.Provider & TAB_IFONT & TAB_ITD
ADOInfo = ADOInfo & TAB_ITR

\'Version
ADOInfo = ADOInfo & TAB_TR
ADOInfo = ADOInfo & TAB_TD & TAB_FONT & \"<B>Version</B>\" & TAB_IFONT & TAB_ITD
ADOInfo = ADOInfo & TAB_TD & TAB_FONT & objConn.Version & TAB_IFONT & TAB_ITD
ADOInfo = ADOInfo & TAB_ITR

ADOInfo = ADOInfo & TAB_ITABLE
ADOInfo = ADOInfo & \"&nbsp;<BR>\"

\'Slet Connection
Set objConn = Nothing
End Function

\'*** Funktion der returnerer tabel-streng med oplysninger om drev ***
Public Function DriveInfo()
Dim objFS, objDrv

\'Filsystem
Set objFS = CreateObject(\"Scripting.FileSystemObject\")

\'Header
DriveInfo = TAB_TABLE
DriveInfo = DriveInfo & TAB_TR
DriveInfo = DriveInfo & \"<TD COLSPAN=5>\" & TAB_FONT & \"<B>Oplysninger om drev</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_ITR

\'Overskrifter
DriveInfo = DriveInfo & TAB_TR
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"<B>Drev (navn)</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"<B>Medie</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"<B>Filsystem</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"<B>Samlet størrelse</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"<B>Ledig plads</B>\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_ITR

\'Gennemgå alle drev
For Each objDrv In objFS.Drives
DriveInfo = DriveInfo & TAB_TR

\'Drev (navn)
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & objDrv.DriveLetter & \" (\"
If objDrv.IsReady Then
DriveInfo = DriveInfo & objDrv.VolumeName
Else
DriveInfo = DriveInfo & \"?\"
End If
DriveInfo = DriveInfo & \")\" & TAB_IFONT & TAB_ITD

\'Medie
DriveInfo = DriveInfo & TAB_TD & TAB_FONT
Select Case objDrv.DriveType
Case 0: DriveInfo = DriveInfo & \"Ukendt\"
Case 1: DriveInfo = DriveInfo & \"Flytbar\"
Case 2: DriveInfo = DriveInfo & \"Fast\"
Case 3: DriveInfo = DriveInfo & \"Netværk\"
Case 4: DriveInfo = DriveInfo & \"CD-ROM\"
Case 5: DriveInfo = DriveInfo & \"RAM disk\"
Case Else: DriveInfo = DriveInfo & \"?\"
End Select
DriveInfo = DriveInfo & TAB_IFONT & TAB_ITD

\'Er der noget i drevet?
If objDrv.IsReady Then
\'Filsystem
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & objDrv.FileSystem & TAB_IFONT & TAB_ITD

\'Størrelse
DriveInfo = DriveInfo & TAB_TDR & TAB_FONT & FormatNumber(objDrv.TotalSize / 1000000, 0) & \" MB\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TDR & TAB_FONT & FormatNumber(objDrv.FreeSpace / 1000000, 0) & \" MB\" & TAB_IFONT & TAB_ITD
Else
DriveInfo = DriveInfo & TAB_TD & TAB_FONT & \"?\" & TAB_IFONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TDR & TAB_FONT & \"? MB\" & TAB_FONT & TAB_ITD
DriveInfo = DriveInfo & TAB_TDR & TAB_FONT & \"? MB\" & TAB_FONT & TAB_ITD
End If
DriveInfo = DriveInfo & TAB_ITR
Next
DriveInfo = DriveInfo & TAB_ITABLE
DriveInfo = DriveInfo & \"&nbsp;<BR>\"

\'Frigiv objekter
Set objFS = Nothing
Set objDrv = Nothing
End Function


\'*** Hjælpefunktioner (for at fange evt. fejl) ***
Private Function ClassCreateObject(strClass)
Dim objTemp

On Error Resume Next
Set objTemp = CreateObject(strClass)
If Err.Number = 0 Then
ClassCreateObject = TypeName(objTemp)
Else
ClassCreateObject = \"?\"
End If

\'Frigiv objekt igen
Set objTemp = Nothing
End Function

Private Function ServerCreateObject(strProgID)
Dim objTemp

On Error Resume Next
Set objTemp = Server.CreateObject(strProgID)
If Err.Number = 0 Then
ServerCreateObject = TypeName(objTemp)
Else
ServerCreateObject = \"?\"
End If

\'Frigiv objekt igen
Set objTemp = Nothing
End Function

Private Function IsGlobal(strVarname)
On Error Resume Next

\'Returner som udganspunkt False
IsGlobal = False

\'Afprøv relevante
Select Case strVarname
Case \"Tools\"
If IsObject(Tools) Then
If Err.Number = 0 Then IsGlobal = True
End If
Case \"MyInfo\"
If IsObject(MyInfo) Then
If Err.Number = 0 Then IsGlobal = True
End If
Case \"Counters\"
If IsObject(Counters) Then
If Err.Number = 0 Then IsGlobal = True
End If
End Select
End Function
%>
Avatar billede Christian V. Dalsgaard Nybegynder
04. juni 2001 - 15:16 #8
lidt langt men what the f*** ;-)
Avatar billede intersurf Nybegynder
06. juni 2001 - 19:32 #9
man kan godt bruge Socket.TCP på min server!!
Avatar billede intersurf Nybegynder
16. juni 2001 - 16:27 #10
lukker
Avatar billede tommyf Nybegynder
16. juni 2001 - 17:33 #11
Man lukker altså ikke ved at skrive \"lukker\".
Man lukker ved at uddele point til dem der har fortjent dem.
Avatar billede soerens Nybegynder
17. juli 2001 - 16:28 #12
Har ingen anelse om hvad i har gang i, men du kan se en liste over hvilke komponenter der er installeret hos Azero vha. nedenstående URL:

http://www.bluebook.dk/serverinfo/serverinfo.asp

Erstat evt. domænenavnet med dit eget, det er det samme på alle deres servere.

/SørenS
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Programmeringssprog kurser
Kurser inden for grundlæggende programmering
Se alle Programmeringssprog kurser

Flere spørgsmål fra ASP kategorien

Titel Indlæg Oprettet Seneste aktivitet
Lost focus Af bsn i ASP 0 07/11/202415:34 -
ASP classic Af bsn i ASP 8 28/10/202423:11 30/10/202422:51
Classic - filer vist med sidste fil først Af bsn i ASP 5 23/05/202409:56 24/05/202400:02
Optimer MySql table med ASP Af poulmadsen i ASP 4 26/04/202417:16 26/04/202418:37
JSON Af ingeman i ASP 3 07/04/202417:53 08/04/202412:09
Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Opret Log ind

Du kan også logge ind via nedenstående tjenester



Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 16:03 Fjern "Seneste" - "Hurtig adgang" Fra Windows 11 - Hvordan ? Af Ikke-ekspert i Windows
23/1214:43 html <Input.. Danske bogstaver Af pjotre i Andet software
23/1214:35 Brænde musik fra usb drev til cd Af Caso i Andet hardware
21/1222:16 Er "OneDrive" et "Must" ? Koster det penge ? Af Ikke-ekspert i Windows
21/1216:42 Windows Media Player - Hvilken version (Versioner) er gode til at afspille og kopiere ? Af Ikke-ekspert i Musik & videoafspillere
White papers
Flere white papers »


Premium
Teaser billede
Historisk million-bøde får Region Syddanmarks it-direktør til at efterlyse nye GDPR-retningslinjer
Læs mere »
Ser med 'stor alvor' på problemer med vand, varme og manglende kontrol i politiets datacenter
Brugere rammes af Microsoft-fejl: M365-produkter er på mystisk vis blevet deaktiveret
Overblik: Danske it-selskaber strømmer ind mod den centrale storby - og det handler ikke om penge
Se alle »
Computerworld
Teaser billede
Mord på it-profil truer San Franciscos status som tech-mekka: Byen er forvandlet til en zombie-by
Læs mere »
Netværkstest: Første mesh-sæt med komplette WiFi 7-features sætter nye rekorder for dækning og hastighed
Her er dommen: Region Syddanmark skal betale historisk stor bøde for grove overtrædelser af GDPR
Nørgaard: Copilot scorer pænt højt i min kendte 3D-test (Dyrt, Dumt, Dårligt)
Se alle »
CIO
Teaser billede
Dansk headhunter: Dette spørgsmål bliver jeg næsten altid stillet, når jeg forsøger at rekruttere it-folk
Læs mere »
Software-selskabernes prisstigninger får nu danske virksomheder til at søge mod open source
AI er et falmende buzzword: Lad mig fluks dele en god og en dårlig nyhed
En af verdens største it-distributører dropper samarbejdet med Broadcom: Kunne ikke nå til enighed
Se alle »
Job & Karriere
Teaser billede
Microsoft klar med ny direktion for den danske forretning: Her er de nye direktører
Læs mere »
Merete Søby klar med nyt top-job efter pludselig exit fra Schultz: Her er hendes nye job
Linus Torvalds giver russiske Linux-udviklere sparket: Vil ikke have noget med dem at gøre
Dansk headhunter: Dette spørgsmål bliver jeg næsten altid stillet, når jeg forsøger at rekruttere it-folk
Se alle »
White paper
Teaser billede
Governance, Risk & Compliance: Knyt stærke bånd mellem forretning og sikkerhed
Læs mere »
Sikkerhed uden grænser: Cisco Hypershield
Derfor kræver AI, cloud og sikkerhed et stærkere netværk
Cyberangreb bliver mere kostbare: Er du forberedt?
Se alle »

Events
Flere events »
White papers
Flere white papers »
IT-Kurser
Se alle vores it-kurser »