/ConvSch.fsx
Last active Aug 29, 2015
[F#]Schedule Board (http://www.rumix.com/sb/) のファイルを変換・修復
| // This file is in the public domain. | |
| #r "System" | |
| #r "System.Drawing" | |
| #r "System.Windows.Forms" | |
| open System | |
| open System.IO | |
| open System.Text | |
| open System.Drawing | |
| open System.Windows.Forms | |
| type ExOpt<'a> = ExSome of 'a | ExErr of int | |
| type MaybeErrorBuilder() = | |
| member this.Bind(x: int * bool, f) = | |
| if snd x then f() else ExErr (fst x) | |
| member this.Return(x) = ExSome x | |
| let maybeError = MaybeErrorBuilder() | |
| let readstr (br:BinaryReader) = | |
| let len = int <| br.ReadByte() | |
| if len = 0 then "" else | |
| let len = if len < 255 then len else int <| br.ReadUInt16() | |
| br.ReadBytes len |> Encoding.Default.GetString | |
| let writestr (bw:BinaryWriter) (s:string) = | |
| let b = Encoding.Default.GetBytes s | |
| if b.Length = 0 then | |
| bw.Write 0uy | |
| elif b.Length < 255 then | |
| bw.Write (byte b.Length) | |
| bw.Write b | |
| else | |
| bw.Write 255uy | |
| bw.Write (uint16 b.Length) | |
| bw.Write b | |
| type Record() = | |
| member val Type = 0 with get, set | |
| member val Start = 0L with get, set | |
| member val End = 0L with get, set | |
| member val Modify = 0L with get, set | |
| member val Color = 0 with get, set | |
| member val Index = 0 with get, set | |
| member val Text = "" with get, set | |
| member val Id = "" with get, set | |
| member val User = "" with get, set | |
| member val Desc = "" with get, set | |
| member r.Write(bw:BinaryWriter) = | |
| bw.Write 0x12c | |
| bw.Write 0x50002 | |
| bw.Write r.Type // 0:新規, 1:修正, 2:削除 | |
| bw.Write 0 | |
| bw.Write r.Start | |
| bw.Write 0 | |
| bw.Write r.End | |
| bw.Write 0 | |
| bw.Write r.Modify | |
| bw.Write r.Color | |
| bw.Write r.Index | |
| writestr bw r.Text | |
| writestr bw r.Id | |
| writestr bw r.User | |
| writestr bw r.Desc | |
| bw.Write 0uy | |
| override r.ToString() = | |
| sprintf "%d,%d,%d,%d,%d,%d,%d,%d,%d,\"%s\",\"%s\",\"%s\",\"%s\"" | |
| r.Type | |
| (r.Start |> int) (r.Start >>> 32 |> int) | |
| (r.End |> int) (r.End >>> 32 |> int) | |
| (r.Modify |> int) (r.Modify >>> 32 |> int) | |
| r.Color r.Index r.Text r.Id r.User r.Desc | |
| member r.Contains (rr:Record) = | |
| rr.Type = 0 && r.Id = rr.Id && | |
| ((r.Start <= rr.Start && rr.Start < r.End) || | |
| (r.Start < rr.End && rr.End <= r.End)) | |
| let readrec (br:BinaryReader) = maybeError { | |
| let r = Record() | |
| do! 1, br.ReadInt32() = 0x12c | |
| do! 2, br.ReadInt32() = 0x50002 | |
| r.Type <- br.ReadInt32() | |
| do! 3, br.ReadInt32() = 0 | |
| r.Start <- br.ReadInt64() | |
| do! 4, br.ReadInt32() = 0 | |
| r.End <- br.ReadInt64() | |
| do! 5, br.ReadInt32() = 0 | |
| r.Modify <- br.ReadInt64() | |
| r.Color <- br.ReadInt32() | |
| r.Index <- br.ReadInt32() | |
| r.Text <- readstr br | |
| r.Id <- readstr br | |
| r.User <- readstr br | |
| r.Desc <- readstr br | |
| do! 6, br.ReadByte() = 0uy | |
| return r } | |
| let readsch f = | |
| use br = new BinaryReader(new FileStream(f, FileMode.Open)) | |
| let ret = new System.Collections.Generic.List<Record>() | |
| let rec loop() = | |
| if br.PeekChar() = -1 then 0, 0L else | |
| let pos = br.BaseStream.Position | |
| match readrec br with | |
| | ExErr e -> | |
| e, pos | |
| | ExSome r -> | |
| ret.Add r | |
| loop() | |
| match loop() with a, b -> a, b, ret.ToArray() | |
| let writecsv (tw:TextWriter) (recs:Record[]) = | |
| recs |> Array.iteri (fun num r -> tw.WriteLine("{0},{1}", num, r)) | |
| let rebuild (recs:Record[]) = | |
| let recs = Array.copy recs | |
| for r in recs do | |
| match r.Type with | |
| | 1 -> | |
| recs.[r.Index].Type <- 3 | |
| r.Type <- 0 | |
| r.Index <- 0 | |
| | 2 -> | |
| recs.[r.Index].Type <- 3 | |
| | _ -> | |
| () | |
| recs |> Array.iteri (fun i r -> | |
| if r.Type = 0 && recs.[i + 1 ..] |> Array.exists r.Contains then | |
| r.Type <- 4) | |
| recs |> Array.filter (fun r -> r.Type = 0) | |
| let suffix f sfx = | |
| let dir = Path.GetDirectoryName f | |
| let name = Path.GetFileNameWithoutExtension f | |
| let ext = Path.GetExtension f | |
| Path.Combine(dir, name + sfx + ext) | |
| let convert f = | |
| let e, pos, recs = readsch f | |
| let fout = Path.ChangeExtension(f, ".csv") | |
| use sw = new StreamWriter(fout, false, Encoding.Default) | |
| writecsv sw recs | |
| if e <> 0 then fprintfn sw "error,%d,%x" e pos | |
| use sw2 = new StreamWriter(suffix fout "-2", false, Encoding.Default) | |
| let recs2 = rebuild recs | |
| writecsv sw2 recs2 | |
| use bw = new BinaryWriter(new FileStream(suffix f "-2", FileMode.Create)) | |
| for r in recs2 do r.Write bw | |
| [<EntryPoint; STAThread>] do | |
| let w = new Form(Text = "SCH 変換修復", AllowDrop = true) | |
| w.Controls.Add (new Label(Text = "ここに .sch ファイルを DnD してください。", | |
| Dock = DockStyle.Fill, | |
| TextAlign = ContentAlignment.MiddleCenter)) | |
| w.DragEnter.Add <| fun e -> | |
| if e.Data.GetDataPresent DataFormats.FileDrop then | |
| e.Effect <- DragDropEffects.Link | |
| w.DragDrop.Add <| fun e -> | |
| let files = e.Data.GetData(DataFormats.FileDrop) :?> string[] | |
| if files <> null then | |
| files | |
| |> Array.filter (fun f -> Path.GetExtension(f).ToLower() = ".sch") | |
| |> Array.iter convert | |
| Application.Run w |
| Attribute VB_Name = "csv2sch" | |
| Option Explicit | |
| Sub WriteStr(T$) | |
| Dim L%, LB As Byte, Buf() As Byte | |
| Buf = StrConv(T, vbFromUnicode) | |
| L = UBound(Buf) + 1 | |
| If L = 0 Then | |
| LB = 0 | |
| Put #1, , LB | |
| ElseIf L < 255 Then | |
| LB = L | |
| Put #1, , LB | |
| Put #1, , Buf | |
| Else | |
| LB = 255 | |
| Put #1, , LB | |
| Put #1, , L | |
| Put #1, , Buf | |
| End If | |
| End Sub | |
| Sub SCH生成() | |
| Dim TMP&, TB As Byte, T&, S1&, S2&, E1&, E2&, M1&, M2&, C&, I&, Tx$, Id$, Us$, Ds$, Y% | |
| Y = 1 | |
| Open "C:\output.sch" For Binary Lock Write As #1 | |
| While Cells(Y, 1) <> "" | |
| T = Cells(Y, 2) | |
| S1 = Cells(Y, 3) | |
| S2 = Cells(Y, 4) | |
| E1 = Cells(Y, 5) | |
| E2 = Cells(Y, 6) | |
| M1 = Cells(Y, 7) | |
| M2 = Cells(Y, 8) | |
| C = Cells(Y, 9) | |
| I = Cells(Y, 10) | |
| Tx = Cells(Y, 11) | |
| Id = Cells(Y, 12) | |
| Us = Cells(Y, 13) | |
| Ds = Cells(Y, 14) | |
| TMP = &H12C: Put #1, , TMP | |
| TMP = &H50002: Put #1, , TMP | |
| Put #1, , T | |
| TMP = 0: Put #1, , TMP | |
| Put #1, , S1 | |
| Put #1, , S2 | |
| TMP = 0: Put #1, , TMP | |
| Put #1, , E1 | |
| Put #1, , E2 | |
| TMP = 0: Put #1, , TMP | |
| Put #1, , M1 | |
| Put #1, , M2 | |
| Put #1, , C | |
| Put #1, , I | |
| WriteStr Tx | |
| WriteStr Id | |
| WriteStr Us | |
| WriteStr Ds | |
| TB = 0: Put #1, , TB | |
| Y = Y + 1 | |
| Wend | |
| Close #1 | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment