Hente variabler fra et .txt dokument

står det hele på en linie - kun adskilt af ;  ?

Ja, men jeg tror godt det kan stilles op så der er linieskift pr. tiende værdi !

<%

sub savedb(var1,var2)

'gemme gemmme
Response.Write "test" & var1 & " " & var2
end sub

  Dim fso, f
  Set fso = CreateObject("Scripting.FileSystemObject")
 
  Set f = fso.OpenTextFile("c:\testfile.txt", 1)
  ReadAllTextFile =  f.ReadAll
  dim AllArray
  dim smallA(10)
  AAr = Split(ReadAllTextFile,";")
  b=0
  a=0
  While a<>UBound(AAr)
   

   
    if b=10 then
        savedb smallA(2),smallA(4)
        ' her angives hvilke af de ti værdier du er interesseret i
       
        b=0
    end if
    smallA(b)=AAr(a)
    b=b+1
   
    a=a+1
  wend

%>

i sub'en savedb, skal du bare indsætte var1 og var2 i din databasestreng. Så burde det virke.

Takker, mange gange...! Jeg vil rode lidt med det...!

Eventuel en ini-fil som kan læses/skrives med følgende:

Funktionerne

Sub WriteINIString(Section, KeyName, Value, FileName)
  Dim INIContents, PosSection, PosEndSection
 
  'Get contents of the INI file As a string
  INIContents = GetFile(FileName)

  'Find section
  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
  If PosSection>0 Then
    'Section exists. Find end of section
    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
    '?Is this last section?
    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
   
    'Separate section contents
    Dim OldsContents, NewsContents, Line
    Dim sKeyName, Found
    OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
    OldsContents = split(OldsContents, vbCrLf)

    'Temp variable To find a Key
    sKeyName = LCase(KeyName & "=")

    'Enumerate section lines
    For Each Line In OldsContents
      If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
        Line = KeyName & "=" & Value
        Found = True
      End If
      NewsContents = NewsContents & Line & vbCrLf
    Next

    If isempty(Found) Then
      'key Not found - add it at the end of section
      NewsContents = NewsContents & KeyName & "=" & Value
    Else
      'remove last vbCrLf - the vbCrLf is at PosEndSection
      NewsContents = Left(NewsContents, Len(NewsContents) - 2)
    End If

    'Combine pre-section, new section And post-section data.
    INIContents = Left(INIContents, PosSection-1) & _
      NewsContents & Mid(INIContents, PosEndSection)
  else'if PosSection>0 Then
    'Section Not found. Add section data at the end of file contents.
    If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then
      INIContents = INIContents & vbCrLf
    End If
    INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
      KeyName & "=" & Value
  end if'if PosSection>0 Then
  WriteFile FileName, INIContents
End Sub

Function GetINIString(Section, KeyName, Default, FileName)
  Dim INIContents, PosSection, PosEndSection, sContents, Value, Found
 
  'Get contents of the INI file As a string
  INIContents = GetFile(FileName)

  'Find section
  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
  If PosSection>0 Then
    'Section exists. Find end of section
    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
    '?Is this last section?
    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
   
    'Separate section contents
    sContents = Mid(INIContents, PosSection, PosEndSection - PosSection)

    If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare)>0 Then
      Found = True
      'Separate value of a key.
      Value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
    End If
  End If
  If isempty(Found) Then Value = Default
  GetINIString = Value
End Function

'Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
  Dim PosB: PosB = InStr(1, sFrom, sStart, 1)
  If PosB > 0 Then
    PosB = PosB + Len(sStart)
    Dim PosE: PosE = InStr(PosB, sFrom, sEnd, 1)
    If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
    If PosE = 0 Then PosE = Len(sFrom) + 1
    SeparateField = Mid(sFrom, PosB, PosE - PosB)
  End If
End Function


'File functions
Function GetFile(ByVal FileName)
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
  'Go To windows folder If full path Not specified.
  If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
    FileName = FS.GetSpecialFolder(0) & "\" & FileName
  End If
  On Error Resume Next

  GetFile = FS.OpenTextFile(FileName).ReadAll
End Function

Function WriteFile(ByVal FileName, ByVal Contents)
 
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
  'On Error Resume Next

  'Go To windows folder If full path Not specified.
  If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
    FileName = FS.GetSpecialFolder(0) & "\" & FileName
  End If

  Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)
  OutStream.Write Contents
End Function

Og filens indhold kan ses sådan ud:

[Generel]
Navn=dgsjdgjgd

osv

Tekstfilen kan sagtens være en .txt-fil

Jeg har problemer med at åbne tekstfilen, når jeg prøver at åbne siden med denne streng : set f=fs.OpenTextFile(Server.MapPath("Db2.txt"),1)
går serveren helt i stå.

Ved i hvorfor ?

hvordan helt i stå - hænger serveren når du kører siden, eller hvad sker der?

Siden kommer ikke med en fejlmelding eller noget, den står bare og leder efter siden, lige som når man laver et endeløs loop. Her afbryder den bare ikke, den bliver ved med at læse siden. Jeg har lavet en set f=fs.OpenTextFile på serveren før.

Hele siden ser således ud nu:
(Jeg har leget lidt med det og fejl fundet en del på siden, så det meste af koden er Deaktiveret.)

<html>
<head>
<title>TXT - MDB converter</title>
</head>

<body>
Dette er en test<br>
<%'Faste variabler
Countx = 1
Seperator = ";"

'Sorteringen
set fs=Server.CreateObject("Scripting.FileSystemObject")
set f=fs.OpenTextFile("D:\wwwroot\Astralis\Db2.txt",1)
Do while Countx =< 5
   
    'LineArr = Split(f.ReadLine,Seperator)s
    'Response.write(LineArr(1) & "<BR>")
    'Response.write(LineArr(2) & "<BR>")
    'Response.write(LineArr(3) & "<BR>")
    'Response.write(LineArr(4) & "<BR>")
    'Response.write(LineArr(5) & "<BR>")
    'Response.write(LineArr(6) & "<BR>")
    'Response.write(LineArr(7) & "<BR>")
    'ArrAll = f.ReadAll
    Response.Write(Countx & "<BR>")
    Countx = Countx + 1
LOOP
set f=Nothing
set fs=Nothing
%>
</body>
</html>

går ovenstående også på fejl?

Ok...! Jeg fandt selv ud af det, det kom til at se sådan her ud :

<%'Faste variabler
Countx = 0
Lineseperator = "vbCrLf"
Seperator = ";"
Replacer = "´"
DBPathRealative = "../../db/Test.mdb"
TXTPathRealative = "Db.Txt"

Set conn=Server.CreateObject("ADODB.Connection")
Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath(DBPathRealative)&";Uid=********;Pwd=*******;"
set Rs=Server.CreateObject("ADODB.recordset")

Function DelDB()
    Rs.open "DELETE FROM AstUK WHERE CatNO <> '' ", conn
End Function

Function InsertToDB(Var1,Var2,Var3,Var4,Var5,Var6,Var7)
    Rs.Open "INSERT INTO AstUk (CatNo, ItemNo, ItemText, PartItemNo, PartItemText, CustomerNo, CustomerName) VALUES ('" & Var1 & "', '" & Var2 & "', '" & Var3 & "', '" & Var4 & "', '" & Var5 & "', '" & Var6 & "','" & Var7 & "')", conn   
End Function

'Sorteringen
set fs=Server.CreateObject("Scripting.FileSystemObject")
set f=fs.OpenTextFile(Server.MapPath(TXTPathRealative),1)
DelDB()
Do while f.AtEndOfStream<>true
   
    ArrNew = Split(f.ReadLine, Lineseperator)
            ArrLine = Split(ArrNew(0), Seperator)
            InsertToDB RTrim(ArrLine(0)), RTrim(ArrLine(1)), Replace(RTrim(ArrLine(2)),"'",Replacer), RTrim(ArrLine(3)), Replace(RTrim(ArrLine(4)),"'",Replacer), RTrim(ArrLine(5)), RTrim(ArrLine(6))
            Countx = Countx + 1
       
LOOP
set f=Nothing
set fs=Nothing
%>

Mange tak for hjælpen alligevel..!