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 dag 15:56 Navigation i Peugeot 3-2008 fra 2017 Af arnepedersen i Andet software
I dag 14:10 Outlook henter ikke mails Af TTA i Office & Kontorpakker
I dag 13:58 vise billeder i kartotek med store ikoner inklusive optagelsesdato Af Malm i Billedbehandling
I dag 13:35 Adobe Elements 2019, Organizer Crasher Af mort1 i Billedbehandling
I går 20:49 pop up black friday Af Malm i Virus
White papers
Flere white papers »


Premium
Teaser billede
Vil købe tele-løsninger til det offentlige for 370 millioner kroner
Læs mere »
Efterspørgslen på AI-regnekraft er enorm - og det smitter af på priserne: "Vi kan sælge næsten alt, hvad vi får ind"
Nyt værtøj fra Microsoft: Snart kan du reparere nedbrudte Windows-enheder på distancen
Politiet skriver kontrakt på 75 millioner kroner med dansk it-firma: Medarbejdere skal flytte ind hos politiet
Se alle »
Computerworld
Teaser billede
Microsofts nye pc er ekstrem billig – men kan blive ekstrem sikker og fleksibel
Læs mere »
Test: Prøv kun disse B&O-hovedtelefoner, hvis du har råd
Kæmpe datalæk på hospital: 750.000 patienters fortrolige data lækket
Telegigant klar med AI-baseret mormor: Holder telefon-svindlere fast i røret med sniksnak og dumme spørgsmål
Se alle »
CIO
Teaser billede
Konsulenthus vil rulle Microsoft 365 Copilot ud til 200.000 ansatte
Læs mere »
Kæmpe-opgave for Danske Bank har banet vej for fuldautomatiseret migrering til cloud: Nu udbredes metoden i hele AWS
Microsofts store årlige event: De tre vigtigste nøglebudskaber fra Satya Nadella om Microsofts fremtid
Tre vigtige erkendelser, som Computerworld tog med hjem fra Gartners store topmøde i Barcelona
Se alle »
Job & Karriere
Teaser billede
Microsoft klar med ny direktion for den danske forretning: Her er de nye direktører
Læs mere »
Efter skelsættende møde med sportscoach: Stor dansk it-arbejdsplads indfører fredags-fri og isbade i arbejdstiden
Linus Torvalds giver russiske Linux-udviklere sparket: Vil ikke have noget med dem at gøre
Topchef Sara Green mener, at der er brug for et radikalt nyt syn på it-ledelse - særligt én ny trend hader hun som pesten
Se alle »
White paper
Teaser billede
SMB og cybertrusler: Brug sikkerhedsressourcerne optimalt
Læs mere »
Sådan får du overblik og beskytter dine cloudapplikationer
Sæt turbo på din cloudperformance og minimér risikoen for DDoS-angreb
Styrk compliance, sikkerhed og overblik med ét hug
Se alle »

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